VBAでフォルダを再帰的に検索する方法について

投稿日：2021年12月2日更新日：2021年12月21日

＜目次＞

(１) VBAでフォルダを再帰的に検索する方法について
　 (１-１) 構文
　 (１-２) サンプルプログラム

(１) VBAでフォルダを再帰的に検索する方法について

VBAでフォルダ内のファイル操作をする際に、サブフォルダが作られていて、複数階層のフォルダ構造になっている場合に、その全部が対象になるように「再帰的に」フォルダ内をループしていく方法をご紹介します。

（動画）イメージ

例えば以下のようなフォルダ構造があった場合に、親フォルダ配下のサブフォルダも再帰的に検索する事で、①～⑦のファイルを全て網羅して処理を行う事ができます。

（例）

親フォルダ
　┗伝票_AAA商店フォルダ
　　┗伝票_AAA商店_20201230_1359.xlsx　⇒①
　　┗伝票_AAA商店_20210828_2048.xlsx　⇒②
　┗伝票_BBBスーパーフォルダ
　　┗伝票_BBBスーパー_20210101_1934.xlsx　⇒③
　　┗伝票_BBBスーパー_20210829_2102.xlsx　⇒④
　　┗伝票_BBBスーパー_20220322_1639.xlsx　⇒⑤
　┗伝票_CCC市場フォルダ
　　┗伝票_CCC市場_20210503_1638.xlsx　⇒⑥
　　┗伝票_CCC市場_20210829_2237.xlsx　⇒⑦

（図１００）やりたい処理のイメージ例

(１-１) 構文

フォルダを再帰的に探索する処理の構文は次の通りです。

（構文）

Public Sub MainProcess()

    '# ファイル操作用オブジェクトの生成
    Dim objFSO As FileSystemObject
    Set objFSO = New FileSystemObject
    
    '# 集計対象のファイルがある、親ファイルのパスを指定
    HostFolder = "C:\"

    '# 親フォルダを指定して再起的フォルダ探索を実行
    AggregateFolderData objFSO.GetFolder(HostFolder)
    
End Sub

Sub AggregateFolderData(Folder)

    '# 引数で与えたフォルダをループし、子フォルダがあれば、更に再帰的な探索を実行
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        AggregateFolderData SubFolder
    Next
    
    '# 引数で与えたフォルダに子フォルダが無ければ、フォルダ配下のファイルを対象にした処理を実行
    Dim File
    For Each File In Folder.Files
        '# 各ファイルに対して行う処理
    Next
End Sub

（図１３２）

＞目次にもどる

(１-２) サンプルプログラム

（サンプル）

'# 集計するブックで、何行目まで転記したか？を管理する値
Dim cursor As Integer

Public Sub MainProcess()

    Dim objFSO As FileSystemObject
    Set objFSO = New FileSystemObject
    
    '# 集計対象の親ファイルのパスを設定します
    '# まずはシートの変数wCにシートの情報をセットします
    Dim wC As Worksheet: Set wC = ThisWorkbook.Worksheets("集計シート")
    '# 「集計対象フォルダ」の値をセットし、最後に「\」を補記
    Dim HostFolder As String: HostFolder = wC.Cells(2, 2).Value + "\"
    
    '# 集計の開始行数をセット
    '# (※今回の例では「集計シート」の明細は5行目から開始するので5をセット)
    cursor = 5
    
    '# 親フォルダを指定して再起的フォルダ探索を実行
    '# (※前半が関数名、後半は引数のパスです)
    AggregateFolderData objFSO.GetFolder(HostFolder)
    
End Sub


Sub AggregateFolderData(Folder)
 
    '# 転記する対象の集計シート
    Dim wC As Worksheet: Set wC = ThisWorkbook.Worksheets("集計シート")
 
    '# 引数で与えたフォルダをループし、子フォルダがあれば、更に再帰的な探索を実行
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        AggregateFolderData SubFolder
    Next
    
    
    '# 各ブックを開く際に使う一時的なWorkbook変数
    Dim tmpBook As Workbook
    '# 開いたブックの行をループする変数
    Dim i1 As Integer
    
    '# 引数で与えたフォルダに子フォルダが無ければ、フォルダ配下のファイルを対象にした処理を実行
    '# (※つまり、これ以上は再帰的にフォルダ検索せずに、現在の直下のファイルを処理する)
    Dim fl
    For Each fl In Folder.Files

        '# ブックを開く
        Set tmpBook = Workbooks.Open(fl)
        Debug.Print tmpBook.Name

        '# 開いたブックの行を順番にループ
        '# (※各伝票の明細行が14行目～なので開始は14、終了の20000は十分大きな値を設定）
        For i1 = 14 To 20000
        
            '# もし開いているブックの明細行が空白ならForループを抜ける
            '# （No、商品名、単価、数量、金額、備考が全て空白の場合）
            If tmpBook.ActiveSheet.Cells(i1, 5) = "" _
            And tmpBook.ActiveSheet.Cells(i1, 6) = "" _
            And tmpBook.ActiveSheet.Cells(i1, 7) = "" _
            And tmpBook.ActiveSheet.Cells(i1, 8) = "" _
            And tmpBook.ActiveSheet.Cells(i1, 9) = "" Then Exit For
            
            '# ヘッダー部の転記
            wC.Cells(cursor, 2) = tmpBook.ActiveSheet.Cells(5, 5)   '# 伝票ID
            wC.Cells(cursor, 3) = tmpBook.ActiveSheet.Cells(7, 3)   '# 顧客ID
            wC.Cells(cursor, 4) = tmpBook.ActiveSheet.Cells(8, 3)   '# 顧客名
            wC.Cells(cursor, 5) = tmpBook.ActiveSheet.Cells(4, 11)  '# 購入日
            
            '# 開いたブックの「i1」行目の必要な列を、集約するブックにコピー
            wC.Cells(cursor, 6) = tmpBook.ActiveSheet.Cells(i1, 4)  '# 明細No
            wC.Cells(cursor, 7) = tmpBook.ActiveSheet.Cells(i1, 5)  '# 商品名
            wC.Cells(cursor, 8) = tmpBook.ActiveSheet.Cells(i1, 6)  '# 単価
            wC.Cells(cursor, 9) = tmpBook.ActiveSheet.Cells(i1, 7)  '# 数量
            wC.Cells(cursor, 10) = tmpBook.ActiveSheet.Cells(i1, 8) '# 金額
            wC.Cells(cursor, 11) = tmpBook.ActiveSheet.Cells(i1, 9) '# 備考
            
            '# 集約するブックの行番号をインクリメント
            cursor = cursor + 1
        Next

        '# ブックを閉じる
        tmpBook.Close

    Next
End Sub

（図１３１）

＞目次にもどる