Public Sub Hierarchical_Folders_and_Files_Listing2()
Dim startFolderPath As String
Dim startCell As Range
Dim n As Long
startFolderPath = Application.ActiveWorkbook.Path
With Sheets("Sheet1")
.Cells.Clear
.Activate
Set startCell = .Range("A1")
End With
n = List_Folders_and_Files2(startFolderPath, startCell)
End Sub
Private Function List_Folders_and_Files2(folderPath As String, destCell As Range) As Long
Static FSO As Object
Dim thisFolder As Object, subfolder As Object
Dim fileItem As Object
Dim n As Long
If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
Set thisFolder = FSO.Getfolder(folderPath)
'Application.ThisWorkbook.Path
'FSO.Getfolder(folderPath)
'Add hyperlink for this folder
destCell.Parent.Hyperlinks.Add Anchor:=destCell, Address:=thisFolder.Path, TextToDisplay:=thisFolder.Name
'List subfolders in this folder
n = 0
For Each subfolder In thisFolder.SubFolders
n = n + 1 + List_Folders_and_Files2(subfolder.Path, destCell.Offset(n + 1, 1))
Next
'Add hyperlink for each file in this folder
For Each fileItem In thisFolder.Files
n = n + 1
destCell.Offset(n, 1).Parent.Hyperlinks.Add Anchor:=destCell.Offset(n, 1), Address:=fileItem.Path, TextToDisplay:=fileItem.Name
Next
List_Folders_and_Files2 = n
End Function