+ Reply to Thread
Results 1 to 3 of 3

Macro to create hyperlink list of every file in a folder, subfolders, and SHORTCUTS

  1. #1
    Registered User
    Join Date
    08-22-2012
    Location
    Boston, MA
    MS-Off Ver
    Excel 2007
    Posts
    4

    Macro to create hyperlink list of every file in a folder, subfolders, and SHORTCUTS

    Hi,

    I use the macro below to create a hyplerlink list all of the files in a folder. I am hoping there is a way to adapt this macro in order to make it also create hyperlinks to every file inside each of the subfolders and shortcuts in the folder. Any help with this would be greatly apprectiated. Thanks.

    Option Compare Text
    Option Explicit

    Function Excludes(Ext As String) As Boolean
    'Function purpose: To exclude listed file extensions from hyperlink listing

    Dim X, NumPos As Long

    'Enter/adjust file extensions to EXCLUDE from listing here:
    X = Array("exe", "bat", "dll", "zip")

    On Error Resume Next
    NumPos = Application.WorksheetFunction.Match(Ext, X, 0)
    If NumPos > 0 Then Excludes = True
    On Error GoTo 0

    End Function

    Sub HyperlinkFileList()
    'Macro purpose: To create a hyperlinked list of all files in a user
    'specified directory, including file size and date last modified
    'NOTE: The 'TextToDisplay' property (of the Hyperlink object) was added
    'in Excel 2000. This code tests the Excel version and does not use the
    'Texttodisplay property if using XL 97.

    Dim fso As Object, _
    ShellApp As Object, _
    File As Object, _
    SubFolder As Object, _
    Directory As String, _
    Problem As Boolean, _
    ExcelVer As Integer

    'Turn off screen flashing
    Application.ScreenUpdating = False

    'Create objects to get a listing of all files in the directory
    Set fso = CreateObject("Scripting.FileSystemObject")

    'Prompt user to select a directory
    Do
    Problem = False
    Set ShellApp = CreateObject("Shell.Application"). _
    Browseforfolder(0, "Please choose a folder", 0, "c:\\")

    On Error Resume Next
    'Evaluate if directory is valid
    Directory = ShellApp.self.Path
    Set SubFolder = fso.GetFolder(Directory).Files
    If Err.Number <> 0 Then
    If MsgBox("You did not choose a valid directory!" & vbCrLf & _
    "Would you like to try again?", vbYesNoCancel, _
    "Directory Required") <> vbYes Then Exit Sub
    Problem = True
    End If
    On Error GoTo 0
    Loop Until Problem = False

    'Set up the headers on the worksheet
    With ActiveSheet
    With .Range("A1")
    .Value = "Listing of all files in:"
    .ColumnWidth = 40
    'If Excel 2000 or greater, add hyperlink with file name
    'displayed. If earlier, add hyperlink with full path displayed
    If Val(Application.Version) > 8 Then 'Using XL2000+
    .Parent.Hyperlinks.Add _
    Anchor:=.Offset(0, 1), _
    Address:=Directory, _
    TextToDisplay:=Directory
    Else 'Using XL97
    .Parent.Hyperlinks.Add _
    Anchor:=.Offset(0, 1), _
    Address:=Directory
    End If
    End With
    With .Range("A2")
    .Value = "File Name"
    .Interior.ColorIndex = 15
    With .Offset(0, 1)
    .ColumnWidth = 15
    .Value = "Date Modified"
    .Interior.ColorIndex = 15
    .HorizontalAlignment = xlCenter
    End With
    With .Offset(0, 2)
    .ColumnWidth = 15
    .Value = "File Size (Kb)"
    .Interior.ColorIndex = 15
    .HorizontalAlignment = xlCenter
    End With
    End With
    End With

    'Adds each file, details and hyperlinks to the list
    For Each File In SubFolder
    If Not Excludes(Right(File.Path, 3)) = True Then
    With ActiveSheet
    'If Excel 2000 or greater, add hyperlink with file name
    'displayed. If earlier, add hyperlink with full path displayed
    If Val(Application.Version) > 8 Then 'Using XL2000+
    .Hyperlinks.Add _
    Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
    Address:=File.Path, _
    TextToDisplay:=File.Name
    Else 'Using XL97
    .Hyperlinks.Add _
    Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
    Address:=File.Path
    End If
    'Add date last modified, and size in KB
    With .Range("A65536").End(xlUp)
    .Offset(0, 1) = File.datelastModified
    With .Offset(0, 2)
    .Value = WorksheetFunction.Round(File.Size / 1024, 1)
    .NumberFormat = "#,##0.0"
    End With
    End With
    End With
    End If
    Next

    End Sub
    Last edited by Billdick7788; 10-26-2012 at 09:46 AM.

  2. #2
    Registered User
    Join Date
    12-24-2010
    Location
    WV
    MS-Off Ver
    Excel 2003
    Posts
    8

    Re: Macro to create hyperlink list of every file in a folder, subfolders, and SHORTCUTS

    Hi,
    I realize that this thread is almost a year old. However, this is exactly what I need with the addition of being able to list the subfolders. Is there someone out there who can modify this to include the subfolder? Any help is greatly appreciated.

  3. #3
    Forum Moderator Fotis1991's Avatar
    Join Date
    10-11-2011
    Location
    Athens(The homeland of the Democracy!). Greece
    MS-Off Ver
    Excel 1997!&2003 & 2007&2010
    Posts
    13,744

    Re: Macro to create hyperlink list of every file in a folder, subfolders, and SHORTCUTS

    Unfotunately you need to start a new thread for this.

    If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread.

    Old threads are often only monitored by the original participants. New threads not only open you up to all possible participants again, they typically get faster response, too.
    Regards

    Fotis.

    -This is my Greek whisper to Europe.

    --Remember, saying thanks only takes a second or two. Click the little star * below, to give some Rep if you think an answer deserves it.

    Advanced Excel Techniques: http://excelxor.com/

    --KISS(Keep it simple Stupid)

    --Bring them back.

    ---See about Acropolis of Athens.

    --Visit Greece.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1