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

（図１３１）

＞目次にもどる