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

Hi,
I found the below code in another post by Billdick7788. This code will list all the files in a folder and create hyperlinks. However I need it to list all the subfolders and files within each of the subfolders as well. If anyone one could modify it to do that, it would be greatly appreciated.

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

Moderator Note:

Pls use code tags around your code next time as per forum rules.

try it with this modification:

Option Compare Text
Option Explicit

Dim m_fso As Object

Function Excludes(ByVal 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 m_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
        If Err.Number <> 0 Then
            Problem = True
            Select Case MsgBox("Retry?", vbYesNo + vbQuestion, "Error")
                Case vbNo
                    Exit Sub
            End Select
        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").Resize(, 4)
            .Value = Array("Path", "File Name", "Date Modified", "File Size (Kb)")
            .Interior.ColorIndex = 15
            .ColumnWidth = Array(100, 50, 15, 15)
            .HorizontalAlignment = xlCenter
        End With
    End With
    
    ListFilesInFolder Directory, True

    Application.ScreenUpdating = True
    
End Sub

Sub ListFilesInFolder(SourceFolderName As String, ByVal IncludeSubfolders As Boolean)

    Dim fsoSrcFolder As Object, fsoSubFolder As Object
    Dim File As Object
    Dim lngRow As Long

    Set fsoSrcFolder = m_fso.GetFolder(SourceFolderName)
        
    With ActiveSheet
        
        For Each File In fsoSrcFolder.Files
            If Not Excludes(Split(File.Name, ".")(UBound(Split(File.Name, ".")))) Then
                
                lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                
                '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:=.Cells(lngRow, 1), Address:=SourceFolderName, TextToDisplay:=SourceFolderName
                    .Hyperlinks.Add Anchor:=.Cells(lngRow, 2), Address:=File.Path, TextToDisplay:=File.Name
                Else 'Using XL97
                    .Hyperlinks.Add Anchor:=.Cells(lngRow, 1), Address:=File.Path
                    .Cells(lngRow, 1).Value = File.Name
                    .Hyperlinks.Add Anchor:=.Cells(lngRow, 2), Address:=File.Path
                End If
                'Add date last modified, and size in KB
                With .Cells(lngRow, 3)
                    .Value = File.datelastModified
                    .NumberFormat = "mm/dd/yyyy"
                    With .Offset(0, 1)
                        .Value = VBA.Round(File.Size / 1024, 1)
                        .NumberFormat = "#,##0.0"
                    End With
                End With

            End If
        Next File
    End With
    
    If IncludeSubfolders Then
        For Each fsoSubFolder In fsoSrcFolder.SubFolders
            If InStr(fsoSubFolder.Path, "$") < 1 Then
                ListFilesInFolder fsoSubFolder.Path, IncludeSubfolders
            End If
        Next fsoSubFolder
    End If
    
End Sub