任意のフォルダ内の「サブフォルダとその中のフィアル名リスト」を作成（サブフォルダが1階層の場合）

Sub prcListFilesInSimpleOrder()
    ' 変数の宣言
    Dim objFSO As FileSystemObject                ' ファイルシステム操作オブジェクト
    Dim fldMain As Folder                         ' メインフォルダを表すオブジェクト
    Dim fldSub As Folder                          ' 各サブフォルダを表すオブジェクト
    Dim filItem As File                           ' 個々のファイルを表すオブジェクト
    Dim lngRow As Long                            ' Excelシートの行番号
    Dim dlgFile As FileDialog                     ' ファイルダイアログオブジェクト
    Dim strFolderPath As String                   ' 選択されたメインフォルダのパス

    ' FileSystemObjectの初期化
    Set objFSO = New FileSystemObject
    
    ' ファイルダイアログの設定
    Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker)
    With dlgFile
        .Title = "メインフォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            strFolderPath = .SelectedItems(1) ' 選択されたフォルダのパス
        Else
            ' ユーザーがキャンセルした場合
            MsgBox "フォルダ選択がキャンセルされました。", vbExclamation
            Exit Sub
        End If
    End With
    
    ' メインフォルダオブジェクトの取得
    Set fldMain = objFSO.GetFolder(strFolderPath)
    
    ' 出力開始行
    lngRow = 1
    
    ' サブフォルダをループ
    For Each fldSub In fldMain.SubFolders
        ' 各ファイルを直接Excelに出力
        For Each filItem In fldSub.Files
            lngRow = lngRow + 1
            With ThisWorkbook.Sheets("Sheet1")
                .Cells(lngRow, 1).Value = strFolderPath    ' メインフォルダのパス
                .Cells(lngRow, 2).Value = fldSub.Name      ' サブフォルダ名
                .Cells(lngRow, 3).Value = filItem.Name     ' ファイル名
            End With
        Next filItem
    Next fldSub
    
    ' オブジェクトのクリーンアップ
    Set filItem = Nothing
    Set fldSub = Nothing
    Set fldMain = Nothing
    Set objFSO = Nothing
    Set dlgFile = Nothing
End Sub