I found a useful code which automatically creates hyperlinks of files in a folder. My problem is that I want the code to also create Hyperlinks of the sub folder within a folder and not its content inside.

wardex.jpg


This code needs to be revised. It only creates hyperlinks of files within a folder and files in a sub folder within a folder.
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, _
    Folder 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


I hope someone can help me with this. I need this for my reports. Thanks a lot!!