指定されたフォルダ内のフォルダ名とファイル名取得

Option Explicit
Option Base 1

Sub GetFolderAndFilesNameList()
  Dim fso As Object
  Dim fileObj As Object         '取得するファイルオブジェクト
  Dim folderObj As Object       '取得対象のフォルダオブジェクト
  Dim parentFolName As String   '取得対象のフォルダ名
  Dim fl As Object, f As Object 'ファイルオブジェクト
  
  Dim r As Long, c As Long
  Dim i As Integer
  Dim maxNum As Long
  
  parentFolName = ""
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  
  '親フォルダを選択するプロシージャの呼び出し
  parentFolName = GetFolderName
  Set folderObj = fso.getFolder(parentFolName)
  
  '時間計測用(開始)-------------
    Dim myspeed As Double
    Dim starttime As Double
    starttime = Timer
  '---------------------------
  
  'シート「フォルダ_ファイル」
  With ThisWorkbook.ActiveSheet
    .Cells.Clear
    .Cells(2, 1).Value = "フォルダ名"
    .Cells(2, 2).Value = "数"
  
    .Rows(2).Font.Bold = True
    
    r = 3
    maxNum = 0
    'サブフォルダ名を取得
    For Each fl In folderObj.SubFolders
      .Cells(r, 1).Value = fl.Name
      
      'サブフォルダ内のファイル名を取得
      c = 3
      Set fileObj = fso.getFolder(fl.Path).Files
      
      For Each f In fileObj
        .Cells(r, c).Value = f.Name
        c = c + 1
      Next f
      
      .Cells(r, 2).Value = c - 3
      r = r + 1
    Next fl
    
    '各行の中で列数の最大値を格納
     maxNum = Application.WorksheetFunction.Max(.Columns(2))
     
     'ファイルを格納している列に連番を入力
     For i = 1 To maxNum
      .Cells(2, i + 2).Value = i
     Next i
    
    .Columns(2).HorizontalAlignment = xlCenter
    .Rows(2).HorizontalAlignment = xlCenter
    .Range(Columns(1), Columns(maxNum + 2)).EntireColumn.AutoFit
  End With
  
  Set fso = Nothing
  Set f = Nothing
  Set fileObj = Nothing
  Set fl = Nothing
  Set folderObj = Nothing
  
  '時間計測用(終了)-------------
    myspeed = Timer - starttime
    Debug.Print "2_処理時間は" & myspeed & "秒です"
  '---------------------------
  
  MsgBox "完了"
    
End Sub

'フォルダ選択ダイアログから、選択されたフォルダパスを取得
Function GetFolderName()
    Dim folderName As String
    folderName = ""
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダ選択"
        If .Show = True Then
            folderName = .SelectedItems(1) 'フルパス
            
        Else
            MsgBox "フォルダを選択してください"
            End
        End If
    End With
    GetFolderName = folderName
End Function