Option Explicit

Dim 中止 As Boolean

Private Sub cmdInit_Click() '初期化
    Call Initialize                     '表示範囲
    Range("folderPath").ClearContents   'フォルダパス
End Sub

Private Sub cmd中止_Click()
    If MsgBox("中止しますか？", vbOKCancel, "中止確認") = vbOK Then
        中止 = True
    End If
End Sub

Private Sub cmfOpenFolder_Click()

    Dim fd As FileDialog    'フォルダダイアログオブジェクト

    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    'フォルダダイアログ表示
    With fd
        .InitialFileName = Range("folderPath") & "\"    '初期フォルダ
        If .Show = False Then Exit Sub                  'ダイアログ表示　キャンセル？
        Range("folderPath") = .SelectedItems(1)         'フォルダパスを記憶
    End With
   
    Dim Title As Range          'タイトル範囲
    Set Title = Range("TITLE")
    
    Dim t0 As Single            '時間測定用
    t0 = Timer                  '開始時刻

    Call Initialize '初期化

    Application.Calculation = xlCalculationManual       '再計算オフ
    Call getFiles(Range("folderPath"), 0, CBool(Range("再帰検索")))         'リスト生成
    Application.Calculation = xlCalculationAutomatic    '再計算オフ
    
    Range("所要時間") = Timer - t0  '所要時間 = 現在時刻 - 開始時刻

End Sub

Private Sub Initialize() '初期化
    '表示範囲クリア　タイトル位置の下からシート最終行まで
    Range("FileList").ClearContents
    Range("所要時間").ClearContents
    Range("ファイル個数") = ""
    中止 = False
End Sub

Sub getFiles(searchPath As String, n As Integer, Optional Recursion As Boolean)

    Dim fso As New FileSystemObject 'ファイルシステムオブジェクト
    Dim objFiles As File            'ファイルオブジェクト
    Dim objFolders As Folder        'フォルダオブジェクト

    DoEvents
    If 中止 Then Exit Sub
    
    On Error Resume Next
    
    'ファイル名の取得
    For Each objFolders In fso.GetFolder(searchPath).SubFolders
        'ファイル情報をシートに表示
        If Not (objFolders Is Nothing) Then
            With Range("TITLE").Range("A1")
                n = n + 1 'フォルダ個数カウントアップ
                Range("ファイル個数") = n
                .Offset(n, 0).Value = fso.GetAbsolutePathName(objFolders.Path)  'フォルダパス
                .Offset(n, 1).Value = fso.GetBaseName(objFolders.Path)          'フォルダ名
                .Offset(n, 2).Value = objFolders.Files.Count                    'ファイル数
                .Offset(n, 3).Value = objFolders.Size                           '合計サイズ
            End With
        End If
    Next
           
    If Not Recursion Then Exit Sub  '≒再帰検索
    
    'サブフォルダ取得
    For Each objFolders In fso.GetFolder(searchPath).SubFolders
        Call getFiles(objFolders.Path, n, Recursion) '再帰呼び出し
    Next

    On Error GoTo 0
    
End Sub