VBA（2007もOK）で，ファイルの再帰検索をしよう　（Application.FileSearchで複数のブックを処理）

バッチ・マクロのTOPへ

以前，下記のエントリーで，Excel VBAマクロのよく使うコードを列挙した。

ドキュメント作成を楽にするための，Excel VBA 頻出８パターン
http://language-and-engineering.hatenablog.jp/entry/20090401/p1

その中には，

シート内の全行のスキャン
ブック内の全シートのスキャン

などの定型処理が含まれていた。

今回はそれに加えて，

フォルダ内（子フォルダも含め）の全ブックのスキャン

のサンプルコードを掲載する。

Excel2000, 2002, 2003, 2007で動作。

下記のような処理を行なう。

フォルダ階層をたどって，存在するすべての.xlsファイルを開く。
それぞれのブックを開いたら，
- A1セルに計算式を書いて
- 保存して
- 閉じる。

Office2007より前のバージョンで

「hoge」というフォルダ内を検索し，発見したすべての.xlsファイルに書き込み。

Sub 全ブックに書き込み()

    '検索対象のフォルダ
    openDir = ThisWorkbook.Path & "\hoge"
    
    'ファイルを検索
    Dim TargetBook As Workbook
    With Application.FileSearch 
        .LookIn = openDir
        .SearchSubFolders = True ' 再帰検索
        .Filename = "*.xls"
        
        If .Execute() > 0 Then ' 該当ファイルがあれば
            For i = 1 To .FoundFiles.Count
                    
                ' シートを開く
                bookpath = .FoundFiles(i)
                'MsgBox bookpath
                Set TargetBook = Workbooks.Open(bookpath)
                
                ' セルを編集
                Range("A1").Formula = "=1+1"
                    ' http://officetanaka.net/excel/vba/cell/cell03.htm
                
                ' 保存して閉じる
                TargetBook.Save
                TargetBook.Close
                       
            Next i
        Else
            MsgBox "ファイルがありません。"
        End If
        
    End With

End Sub

上記のコードは，Excel2003などでは正常に実行できる。

しかしExcel2007では Application.FileSearchの所で「オブジェクトはこの動作をサポートしていません」が出る。

残念ながら，この FileSearch 関数は2007では使えなくなったのだ。

Office2007では

なので2007からは，再帰処理を自分で実装する必要がある。

そこで，Application.FileSearchの2007年版として，FileSearch2007を作り，使いまわす事にしよう。

' Application.FileSearchの2007版。
' フォルダを再帰検索し，マッチしたファイルのパスをコレクションで返す。
'
' ※利用時にはVBEでツール＞参照設定＞Microsoft Scripting Runtime にチェックすること。
' http://blog.livedoor.jp/excelvbamemo/archives/53397448.html
Function FileSearch2007(dir_path, target_extention)

    ' 再帰探索を開始
    Set found_files = New Collection
    Call FileSearch2007_Repeat(dir_path, found_files, target_extention)
        ' 参照渡し http://www.k1simplify.com/vba/tipsleaf/leaf340.html
    
    ' 返り値
    Set FileSearch2007 = found_files

End Function


' フォルダの再帰で呼び出される関数
Private Sub FileSearch2007_Repeat(dir_path, found_files, target_extention)
    
    Set fso = New FileSystemObject
    Set target_folder = fso.GetFolder(dir_path)
        
    ' サブフォルダに再帰
    For Each sub_folder In target_folder.SubFolders
        Call FileSearch2007_Repeat(sub_folder.Path, found_files, target_extention)
    Next sub_folder
    
    ' ファイル
    For Each objFile In target_folder.Files
        With objFile
            
            ' 検索条件にマッチするか
            If ((UCase(fso.GetExtensionName(.Path))) = target_extention) Then
                
                ' 登録
                found_files.Add Item:=.Path
                    ' コレクション http://www.moug.net/tech/exvba/0150076.htm
            
            End If
        
        End With
    Next objFile
    
    ' このフォルダと子フォルダの処理が終了
    Set fso = Nothing

End Sub

冒頭のコメントで書いてあるが，参照設定を忘れずに。

使い方は下記のとおり。

Sub 全ブックに書き込み()
    
    ' 探索を開始したいフォルダ
    dir_path = ThisWorkbook.Path & "\hoge"
    
    ' 探索したいファイルの拡張子
    target_extention = UCase("xlsx")

    ' 探索
    Set found_files = FileSearch2007(dir_path, target_extention)
    
    ' 見つかったファイルに対して
    found_num = found_files.Count
    If found_num = 0 Then
        MsgBox "見つかりません"
    Else
        MsgBox found_num & "個見つかりました"
        For i = 1 To found_num
                
            ' シートを開く
            bookpath = found_files(i)
            'MsgBox bookpath
            Set TargetBook = Workbooks.Open(bookpath)
            
            ' 編集
            Range("A1").Formula = "=1+1"
            
            ' 保存して閉じる
            TargetBook.Save
            TargetBook.Close
            
            ' Excel2007で保存時にアラートを出さないためには，下記の設定を行なうこと
            ' http://q.hatena.ne.jp/1231912436
            
        Next i
    End If

End Sub

「探索」のところで，上で定義した FileSearch2007 を呼び出している。

なお，保存時の

プライバシーに関する注意：このドキュメントには、マクロ、ActiveXコントロール、XML拡張パックの情報、またはWebコンポーネントが含まれています。これらにはドキュメント検査機能で削除することができない個人情報が含まれる場合があります。

というアラートを出さないように，コメント中の設定を行なっておくこと。

これらを利用すれば，「作成済みのドキュメントを一括書き換え」なども楽にできるだろう。

例えば，全ブックで所属部署を更新する必要が生じたとか。

手動ではやりたくない作業なので，その手の処理はぜひマクロに任せよう。