Rainbow Engine

IT技術を分かりやすく簡潔にまとめることによる学習の効率化、また日常の気付きを記録に残すことを目指します。

VBA

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

投稿日:2021年12月2日 更新日:

 

<目次>

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

(1) 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 ⇒⑦

(図100)やりたい処理のイメージ例

(1-1) 構文

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

(構文)
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
 

(図132)

目次にもどる

(1-2) サンプルプログラム

(サンプル)

'# 集計するブックで、何行目まで転記したか?を管理する値
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

(図131)

目次にもどる

Adsense審査用広告コード


Adsense審査用広告コード


-VBA

執筆者:


comment

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

関連記事

VBAでcsvを読み込み区切り文字で区切る方法

  <目次> (1) VBAでcsvを読み込み区切り文字で区切る方法  (1-1) 構文  (1-2) サンプルプログラム  (1-3) サンプルプログラムの実行結果 (1) VBAでcsv …

VBAで処理と処理の間に一定時間を空けて実行する方法

今回はVBAで処理と処理の間に一定時間を空けて実行する方法について、備忘も兼ねて記載します。 (0)目次&概説 (1) Application.wait (2) サンプルプログラムソース (3) サン …

VBAでシート名をブックを手で開かずに取得してリネームする方法

<目次> (1) VBAでシート名をブックを手で開かずに取得してリネームする方法  (1-1) 構文  (1-2) サンプルプログラム  (1-3) 操作動画紹介・VBAダウンロード (1) VBAで …

VBA・VB(VB.NET)・VBSの違いやそれぞれの特徴について

  <目次> (1) VBA・VB(VB.NET)・VBSの違いやそれぞれの特徴について  (1-1) VBA  (1-2) VB.NET  (1-3) VBS  (1-4) 三者の比較表 …

VBAによる郵便番号の正規表現マッチ確認関数&置換関数の作成

  (0)目次&概説 (1) 正規表現とは (2) 正規表現はどのような場面で利用される? (3) VBAによる正規表現の簡易チェックツール  (3-1) 郵便番号を抽出したい  (3-2) …

  • English (United States)
  • 日本語
Top