【VBA】サブフォルダまで検索し、特定のシートを実行する方法
<スポンサーリンク>
VBAを使用して、データベースを構築しようとすると、
・人によってはサブフォルダを使ってきれいにデータを保存している人
・乱雑にデータが並んでいる人
など、様々なデータの持ち方をしていることがわかります。
そこで今回は、サブフォルダーまですべて読み込んで、
ファイルを実するプログラムを書いていきたいと思います。
サブフォルダまで検索し、実行するプログラム紹介
サブフォルダまで検索し、指定した名前と一致した場合にそのファイルを
実行するプログラムは下記の通りです。
↓のプログラムの場合は、「C:\Downloads」の中の「SAMPLE1.xls」を実行しています。
※ダブルクリックでコピーできます。
01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | Sub JIKKOU() Call searchFolder("C:\Downloads")'←検索したいフォルダを指定する。 End SubSub 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でファイルを実行しています。
01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 | 'フォルダ内全部 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階層目以降を検索するために、
この部分があります。
1 2 3 4 5 6 | '子フォルダも同様に、subFolderを実行する。With CreateObject("Scripting.FileSystemObject") For Each childf In .GetFolder(Path).SubFolders Call searchFolder(childf.Path) NextEnd With |
子フォルダに対しても、1階層目と同じ処理をしたいので、
関数内で同じ関数を繰り返しています。
こうすることで、サブフォルダがある限りこの関数内をループし続け、
すべてのファイルを検索することができます。
理解してしまえばそこまで難しいと思いませんので、
是非ご活用ください。
コメント欄