サブフォルダーとファイル

Sub test3()
 Dim fso As FileSystemObject, fol As Folder, sfol As Folder, f As File
 Dim ws As Worksheet
 Dim rn As Range
 Dim fn As String

 Set fso = CreateObject("scripting.filesystemobject")
 Set fol = fso.GetFolder(ThisWorkbook.Path)
 Set ws = ActiveSheet
 Set rn = ws.Cells(2, 1)
 For Each sfol In fol.SubFolders
 For Each f In sfol.Files
 rn.Value = sfol.Name
 fn = Left(f.Name, InStr(1, f.Name, ".") - 1)
 ws.Hyperlinks.Add anchor:=rn.Offset(, 1), Address:=f.Path, TextToDisplay:=fn
 Set rn = rn.Offset(1)
 Next
 Next

 End Sub

'Microsoft Scripting Runtime