サブフォルダ内のファイル名を一覧表示する

ファイル内の.txtファイルのファイル名を別々のフォルダにリストアップしようとしています（sample picture）以下のコードは、うまく機能しますが、特定のサブフォルダや配置は含まれていませんフォルダヘッダーの列。サブフォルダ内のファイル名を一覧表示する

誰かがここで正しい方向に向けることができますか？

だから、

Option Explicit 
Sub GetFileNames() 
Dim xRow As Long 
Dim xDirect$, xFname$, InitialFoldr$ 
InitialFoldr$ = "C:\main folder dir\" 
With Application.FileDialog(msoFileDialogFolderPicker) 
.InitialFileName = Application.DefaultFilePath & "\" 
.Title = "Please select a folder to list Files from" 
.InitialFileName = InitialFoldr$ 
.Show 
If .SelectedItems.Count <> 0 Then 
xDirect$ = .SelectedItems(1) & "\" 
xFname$ = Dir(xDirect$, 7) 
Do While xFname$ <> "" 
ActiveCell.Offset(xRow) = xFname$ 
xRow = xRow + 1 
xFname$ = Dir 
Loop 
End If 
End With 
End Sub

：

Subfoldername1 | Subfoldername2 
-------------- | -------------- 
Textfile1  | Textfile3 
Textfile2  | Textfile4

出典

2017-07-10 David Fontijn

サブサブフォルダがある場合は何？ – WhatsThePoint

はこれを試してみてください：

Sub FolderNames() 
Dim sht As Worksheet 
Dim fso As Object, fl1 As Object, fl2 As Object 
Dim lCol As Long 
Dim Files As String, sPath As String 

Set fso = CreateObject("Scripting.FileSystemObject") 
Set sht = Worksheets("Sheet1") 

With Application.FileDialog(msoFileDialogFolderPicker) 
    .AllowMultiSelect = False 
    .Title = "Please Select a Folder" 
    .Show 
    If .SelectedItems.Count <> 0 Then sPath = .SelectedItems(1) 
End With 

Set fl1 = fso.GetFolder(sPath) 

With sht 
    lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
    If .Cells(1, lCol).Value = "" Then 
     .Cells(1, lCol) = sPath 
    Else 
     .Cells(1, lCol + 1) = sPath 
    End If 
End With 

For Each fl2 In fl1.SubFolders 
    lCol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column 
    sht.Cells(1, lCol + 1).Value = Right(fl2, Len(fl2) - InStrRev(fl2, "\")) 
    Files = Dir(fl2 & "\*.txt") 
    Do While Files <> "" 
     With sht 
      lrow = .Cells(.Rows.Count, lCol + 1).End(xlUp).Row 
      .Cells(lrow + 1, lCol + 1).Value = Files 
     End With 
     Files = Dir() 
    Loop 
Next 
sht.Columns.AutoFit 
End Sub

それはそれで.TXTで選択したパスとすべてのフォルダの一覧が表示されます。しかし、サブ・サブフォルダはありません。出力：