File List with HyperLinks to Subdirectories

[Laughlete]

I found this code on the Internet. It creates a file list in excel with hyperlinks to files in a folder. It works perfectly.

I need the code edited to create a file list of a directory and its subdirectories. I played with the path line but I couldn't figure it out.

Can somebody edit this code to search directories and subdirectories. Any help will be appreciated.

LW

Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:StuffBusinessTemp")
i = 1
'loops through each file in the directory
For Each objFile In objFolder.Files
'select cell
Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
'create hyperlink in selected cell
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
objFile.Path, _
TextToDisplay:=objFile.Name
i = i + 1
Next objFile
End Sub

 

[djl0525]

Following this thread... hoping to see a solution soon.

DJ

 

[Eric H]

I am just a novice but, is this what you are looking for?

Public Sub Tester_1()

Dim Obj_Fso As Object
Dim Obj_Main_Folder As Folder, Str_Main_Folder_Path As String
Dim Obj_Sub_Folder As Folder, Str_Sub_Folder_Path As String
Dim Increment_Variable As Long

Dim WB As Workbook, Ws As Worksheet
Dim Rng_Worksheet_Output As Range

Str_Main_Folder_Path = "D:\Users\User Name\Location of Main Folder Ex: Desktop\Main Folder Name"

Set Obj_Fso = CreateObject("Scripting.FileSystemObject")
Set Obj_Main_Folder = Obj_Fso.GetFolder(Str_Main_Folder_Path)

Set WB = ActiveWorkbook
Set Ws = WB.ActiveSheet
Set Rng_Worksheet_Output = Ws.Cells(10, 1)

For Each Obj_Sub_Folder In Obj_Main_Folder.SubFolders

Str_Sub_Folder_Path = Obj_Sub_Folder.Path

Rng_Worksheet_Output.Hyperlinks.Add _
Anchor:=Rng_Worksheet_Output.Cells(1, 1).Offset(Increment_Variable, 0), _
Address:=Obj_Sub_Folder.Path, _
TextToDisplay:=Str_Sub_Folder_Path

Increment_Variable = Increment_Variable + 1

Next Obj_Sub_Folder

End Sub