【VBA】サブフォルダまで検索し、特定のシートを実行する方法

【VBA】サブフォルダまで検索し、特定のシートを実行する方法
サブフォルダまで検索し、実行するプログラム紹介
プログラムの説明

【VBA】サブフォルダまで検索し、特定のシートを実行する方法

<スポンサーリンク>

VBAを使用して、データベースを構築しようとすると、
・人によってはサブフォルダを使ってきれいにデータを保存している人
・乱雑にデータが並んでいる人
など、様々なデータの持ち方をしていることがわかります。

そこで今回は、サブフォルダーまですべて読み込んで、
ファイルを実するプログラムを書いていきたいと思います。

サブフォルダまで検索し、実行するプログラム紹介

サブフォルダまで検索し、指定した名前と一致した場合にそのファイルを
実行するプログラムは下記の通りです。
↓のプログラムの場合は、「C:\Downloads」の中の「SAMPLE1.xls」を実行しています。

※ダブルクリックでコピーできます。

Sub JIKKOU()

        Call searchFolder("C:\Downloads")'←検索したいフォルダを指定する。
    
End Sub


Sub searchFolder(Path As String)
    Dim buf As String, childf As Object

'フォルダ内全部
    buf = Dir(Path & "\*.*")
   
    Do While buf <> ""
    
    '名前が一致したら実行するように指示。
    If buf = "SAMPLE1.xls" Then　'←ファイル名を指定してください。
    
        With CreateObject("Wscript.Shell")
            .Run Path & "\" & buf
        End With
        
        Exit Sub

    End If
    '次のファイル
        buf = Dir()
    Loop
    
    '子フォルダも同様に、subFolderを実行する。
    With CreateObject("Scripting.FileSystemObject")
        For Each childf In .GetFolder(Path).SubFolders
            Call searchFolder(childf.Path)
        Next
    End With
    
End Sub

プログラムの説明

まずは、1階層目を検索するプログラムです。
Dir関数とDo While関数を使って、
・Path内のフォルダを頭からすべて検索していきます。
・その中で(IF文で)、名前が一致したときに、Wscript.Shellでファイルを実行しています。

'フォルダ内全部
    buf = Dir(Path & "\*.*")
    Do While buf <> ""
    
    '名前が一致したら実行する場合は↓
    If buf = "SAMPLE1.xls" Then　'←ファイル名を指定してください。
    
        With CreateObject("Wscript.Shell")
            .Run Path & "\" & buf
        End With
        
        Exit Sub

    End If
    '次のファイル
        buf = Dir()
    Loop

ここまでは、よくある定型文のテクニックです。

ここから、2階層目以降を検索するために、
この部分があります。

    '子フォルダも同様に、subFolderを実行する。
    With CreateObject("Scripting.FileSystemObject")
        For Each childf In .GetFolder(Path).SubFolders
            Call searchFolder(childf.Path)
        Next
    End With

子フォルダに対しても、1階層目と同じ処理をしたいので、
関数内で同じ関数を繰り返しています。

こうすることで、サブフォルダがある限りこの関数内をループし続け、
すべてのファイルを検索することができます。

理解してしまえばそこまで難しいと思いませんので、
是非ご活用ください。