【Excel VBA】FileSystemObjectを使いこなす！（実践編）　第五回目　フォルダ以下のすべてのファイルパスを取得する（階層構造版）

Dim tRow As Long
Dim ws As Worksheet

Private Sub GetFileFolderInformation()
         
    Dim FSO As New Scripting.FileSystemObject
    Dim FD As FileDialog
    Dim FolderName As String
    Dim objFolder As Scripting.Folder
    Dim tColumn As Long
    
    'グローバル変数の初期化
    tRow = 0
    
    '最初のセル情報を与える
    Set ws = ThisWorkbook.Worksheets("Sheet1")
        tRow = 2
        tColumn = 2
        
    'フォルダを選択する(FileDialogとGetoFolder)
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    
    If FD.Show = True Then
        FolderName = FD.SelectedItems(1)
        Set objFolder = FSO.getFolder(FolderName)
        Call getFolder(objFolder, tColumn)
    End If
    
End Sub

Sub getFolder(objFolder As Scripting.Folder, ByVal tColumn As Long)
    
    Dim objSubFolder As Scripting.Folder
    Dim objFile As Scripting.File
    
    
    'フォルダ名を取得する
    ws.Cells(tRow, tColumn).Value = objFolder.Name
    'セルにハイパーリンクを貼る
    ws.Hyperlinks.Add Anchor:=Cells(tRow, tColumn), Address:=objFolder.Path, TextToDisplay:=objFolder.Name
    
    '1列ずれる（下層に当たる為）
    tColumn = tColumn + 1
    
    'サブフォルダオブジェクトを取得する
    For Each objSubFolder In objFolder.SubFolders
        Call getFolder(objSubFolder, tColumn)
    Next
    
    
    '下層にファイルがない場合は1行ずれる。ある場合はずれない
    If objFolder.Files.Count = 0 Then
        tRow = tRow + 1
    Else
        'ファイル名を記載する
        For Each objFile In objFolder.Files
            ws.Cells(tRow, tColumn).Value = objFile.Name
            'セルにハイパーリンクを貼る
            ws.Hyperlinks.Add Anchor:=Cells(tRow, tColumn), Address:=objFile.Path, TextToDisplay:=objFile.Name
            '1行ずれる(同階層の為）
            tRow = tRow + 1
        Next
    End If
   
End Sub