VBAで全ファイルを一覧表示するサンプル

f:id:keiaruesu:20210419211946j:plain
エクセルマクロで指定フォルダ以下のファイルやフォルダに対していろいろ処理をしたいということはよくあると思うのでその雛型になるサンプルを置いておく

ファイル一覧出力の簡単なサンプルコード

とりあえずアルゴリズムがどうなってんのか分かりやすくしたコードがコレ
エクセルVBAに貼り付けて「execFileListOutput」を呼び出せば動くと思う

なるべく簡単にしたサンプルコード

Option Explicit

'必要な参照設定
'Microsoft Scripting Runtime

'出力ログの開始Range
Dim logStartRange As Range

'ファイルリスト出力処理の呼び出し元
Public Sub execFileListOutput()
    
    '検索するフォルダパスの指定
    Dim searchPath As String
    searchPath = "C:\Users\Public\Documents"
    
    'リスト書き出しの開始位置
    Set logStartRange = Range("A10")
    
    'ヘッダを作成
    logStartRange.Offset(0, 0) = "ファイルパス"
    logStartRange.Offset(0, 1) = "ファイル名"
    
    'セルを初期位置へ移動
    logStartRange.Activate
    
    'ファイルの一覧出力開始
    Call getFileList(searchPath)

    '横幅調整
    Cells.Columns.AutoFit

    Call MsgBox("処理が終わりました")

End Sub

'ファイルリストの出力処理
'再帰呼び出しでサブフォルダも探索するよ
Private Sub getFileList(ByVal searchPath As String)
    
    Dim fso As New FileSystemObject
    Dim objFile As File
    Dim lastLogRange As Range
    
    'ファイルの取得
    For Each objFile In fso.GetFolder(searchPath).Files
        
        'ログ最終行の1行下を取得
        Set lastLogRange = ActiveCell.Offset(1, 0)
        lastLogRange.Activate
        
        'ファイルの情報を書き出し
        'パス
        lastLogRange.Offset(0, 0).Value = objFile.Path
        'ファイル名
        lastLogRange.Offset(0, 1).Value = objFile.Name
    Next

    'サブフォルダの探索
    Dim objSubFolder As Folder
    
    For Each objSubFolder In fso.GetFolder(searchPath).SubFolders
        
        '再起呼び出しだよ
        Call getFileList(objSubFolder.Path)
    Next

End Sub

getFileListでファイル一覧を出力、サブフォルダがあった場合getFileListの中でgetFileListを呼び出すことでサブフォルダ内でも一覧出力処理を繰り返す典型的な再帰呼び出しの処理だね
より実践的にするにはアクセス権の関係とかで開けないファイルフォルダが稀によく出てくるのでエラー処理やファイルフォルダの属性チェックなどをする処理を割と入念に入れておこう

より実践的なサンプルコード

ファイルとフォルダの一覧をガーっと出す処理をしている
コメント個所に処理を書けば各フォルダや各ファイルに対して処理するようなコードが書けると思うよ

サンプルコード

Option Explicit

'必要な参照設定
'Microsoft Scripting Runtime

'出力ログの開始Rangeアドレス
Const LOG_START_RANGE_STR As String = "A10"

'出力ログの開始Range
Dim logStartRange As Range

'ファイルリスト出力処理の呼び出し元
Public Sub execFileListOutput()
    
    '検索するフォルダパスの指定
    Dim searchPath As String
    searchPath = "C:\Users\Public\Documents"
    
    'リスト書き出しの開始位置
    Set logStartRange = Range(LOG_START_RANGE_STR)
    
    'ログ開始位置から下を全部クリア
    Call Range(logStartRange.Row & ":" & Rows.Count).Clear
    
    'ヘッダを作成
    logStartRange.Offset(0, 0) = "ファイルパス"
    logStartRange.Offset(0, 1) = "ファイル名"
    logStartRange.Offset(0, 2) = "フォルダパス"
    logStartRange.Offset(0, 3) = "更新日"
    logStartRange.Offset(0, 4) = "サイズ"
    logStartRange.Offset(0, 5) = "種類"
    logStartRange.Offset(0, 6) = "属性"

    'ヘッダに背景色設定
    Range(logStartRange, logStartRange.Offset(0, 6)).Interior.ThemeColor = XlThemeColor.xlThemeColorDark2

    'ファイルの一覧出力開始
    Call getFileList(searchPath)

    '横幅調整
    Cells.Columns.AutoFit

    Call MsgBox("処理が終わりました")

End Sub

'ファイルリストの出力処理
'再帰呼び出しでサブフォルダも探索するよ
Private Sub getFileList(ByVal searchPath As String)

    On Error GoTo errCatch
    
    Dim fso As New FileSystemObject
    Dim objFile As File
    Dim lastLogRange As Range
    
    '◆◆◆◆
    'フォルダに対して個別に何らかの処理をかけたいときは
    'ここに処理を書くといいよ
    '例としてフォルダの情報を出力する
    Dim objFolder As Folder
    Set objFolder = fso.GetFolder(searchPath)
    
    'ログ最終行の1行下を取得
    Set lastLogRange = Cells(Rows.Count, logStartRange.Column).End(xlUp).Offset(1, 0)
    
    'フォルダの情報を書き出し
    'パス
    lastLogRange.Offset(0, 0).Value = objFolder.Path
    'フォルダ名
    lastLogRange.Offset(0, 1).Value = objFolder.Name
'    'フォルダパス
'    lastLogRange.Offset(0, 2).Value = objFolder.ParentFolder
    '更新日
    lastLogRange.Offset(0, 3).Value = objFolder.DateLastModified
'    'サイズ
'    lastLogRange.Offset(0, 4).Value = objFolder.Size
    '種類
    lastLogRange.Offset(0, 5).Value = objFolder.Type
    '属性
    lastLogRange.Offset(0, 6).Value = objFolder.Attributes
    
    'ファイルの取得
    For Each objFile In fso.GetFolder(searchPath).Files
        
        '◆◆◆◆
        'ファイルに対して個別に何らかの処理をかけたいときは
        'ここに処理を書くといいよ
        '例として各ファイルのファイル情報を出力する
        
        'ログ最終行の1行下を取得
        Set lastLogRange = Cells(Rows.Count, logStartRange.Column).End(xlUp).Offset(1, 0)
        
        'ファイルの情報を書き出し
        'パス
        lastLogRange.Offset(0, 0).Value = objFile.Path
        'ファイル名
        lastLogRange.Offset(0, 1).Value = objFile.Name
        'フォルダパス
        lastLogRange.Offset(0, 2).Value = objFile.ParentFolder
        '更新日
        lastLogRange.Offset(0, 3).Value = objFile.DateLastModified
        'サイズ
        lastLogRange.Offset(0, 4).Value = objFile.Size
        '種類
        lastLogRange.Offset(0, 5).Value = objFile.Type
        '属性
        lastLogRange.Offset(0, 6).Value = objFile.Attributes
    Next

    'サブフォルダの探索
    Dim objSubFolder As Folder
    
    For Each objSubFolder In fso.GetFolder(searchPath).SubFolders
        
        '再起呼び出しだよ
        Call getFileList(objSubFolder.Path)
    Next

    Exit Sub

errCatch:
    '権限やらなんやらで開けないフォルダは結構あるので
    'エラー回避処理しておいた方がよい
    Debug.Print (Now & " : getFileList : なんかエラー ==========")
    Debug.Print ("Err.Source  : " & Err.Source)
    Debug.Print ("Err.Number : " & Err.Number)
    Debug.Print ("Err.Description : " & Err.Description)
    Debug.Print ("searchPath : " & searchPath)
    Debug.Print ("")

End Sub
小ネタ

ログの最終行取得処理があまり洗練されていないのが気になってる
あんまメソッド増やしたくなかったけどgetLastLogRangeみたいなの用意したほうがよかったかも