この記事では、マクロでパソコン内からフォルダやファイルを探し出す方法についてご説明します。
【動画】マクロでパソコン内からフォルダやファイルを探し出す実際の動き
本題に入る前に、まずは次のツイートをご覧ください。
パソコン内からフォルダやファイルを探し出すマクロを作成してみました😊
パソコン内に置いたファイルがどこにあるのかわからなくなった時に役に立つと思います😀
※一部処理時間がかかっているところを動画に収めるためカットしています💦#ExcelVBA#コマンドプロンプト pic.twitter.com/F6sWpkYBgS
— まさ@Excel、VBA、マクロ（経験年数16年） (@masamasa9785) October 2, 2021
処理は大まかに次の3つを行っています。
- コマンドプロンプトを呼び出してdirコマンドでサブフォルダ含めて全てのフォルダ名とファイル名を取得してCSVに書き出す
- ①のCSVファイルに書き出されたフルパスを、パスとフォルダ名またはファイル名に分割してExcelのシートのに書き出す
- ②のシートのセルの値を読み込んでListboxsに表示させる
マクロでパソコン内からフォルダやファイルを探し出す方法
マクロでパソコン内からフォルダやファイルを探し出すのに、今回紹介するマクロを実行するのに次の3つを行っています。
- セルの名前設定
- コントロールの配置
- Excelのマクロの作成
セルの名前設定
今回の記事で紹介するマクロを実行するために、一部のセルに名前を付けています。
searchpath
探す対象のパスを指定するセルに、「searchpath」という名前を付けます。
例えば、Cドライブ配下全てでフォルダやファイルを検索する場合は「c:\」または「c:」と入力します。
searchStr
探したいフォルダ名やファイル名、もしくは探したいフォルダやファイルの文字列の一部を入力するセルに「searchStr」という名前を付けます。
このセルに探したいフォルダ名やファイル名、もしくは探したいフォルダやファイルの文字列の一部を入力して検索します。
例えば、「work」というフォルダ名や「test.txt」というファイル名を探す場合は、このセルに「work」または「test.txt」と入力し、検索すると検索結果が表示されます。
また、探したいフォルダやファイルの文字列の一部だけで検索する場合、例えば「temp」という文字列だけで探す場合は「temp」と入力します。
文字列の一部だけで検索した場合は文字列を含むフォルダやファイルが検索結果に表示されます。
コントロールの配置
今回の記事では、探し出したパソコン内のフォルダやファイルを表示させる用にlistboxのコントロールを配置します。
他に、検索方法の種類別にオプションボタンや、マクロを実行するための実行ボタンも配置しています。
ちなみに、下の画像のように配置しました。
listbox1(ActiveXコントロール)
listboxで検索結果を表示させます。
opb_allmatch(フォームコントロール)
フォルダやファイルを「完全一致」で検索するよう設定するオプションボタンです。
フォルダ名やファイル名と完全に一致するフォルダやファイルを検索します。
完全に一致しないと検索がヒットしません。
opb_partmatch(フォームコントロール)
フォルダやファイルを「部分一致」で検索するよう設定するオプションボタンです。
フォルダ名やファイル名の一部の文字列だけでフォルダやファイルを検索します。
opb_fwdmatch(フォームコントロール)
フォルダやファイルを「前方一致」で検索するよう設定するオプションボタンです。
フォルダ名やファイル名の前の文字から順に条件に一致するフォルダやファイルを検索します。
opb_rearmatch(フォームコントロール)
フォルダやファイルを「後方一致」で検索するよう設定するオプションボタンです。
フォルダ名やファイル名の後ろの文字から順に条件に一致するフォルダやファイルを検索します。
Excelのマクロの作成
Excelのマクロの作成の流れ
なお、書き出せるのは1行ずつです。(1度にまとめて複数行(または全行)書き出すことはできません)
コードの例
Excelのマクロのコード(例)
Sub test()
Dim buf As String '一時的な値の格納先変数
Dim getPath As String 'サブフォルダ含めて全てのフォルダ名とファイル名を取得したいパス
Dim cmdTxt As String 'コマンドプロンプトのコード用変数
Dim shtExistFlg As Boolean 'シート存在確認フラグ
Dim rPos_cnt As Long 'シートの行位置用カウンタ
Dim ws As Worksheet 'Worksheet用変数
Dim fldrFileNMExptTxt As String 'フォルダ名とファイル名が出力されたファイル名
Dim st As ADODB.Stream 'バイナリ データまたはテキストのストリームのインスタンス用変数
Dim wshObj As WshShell 'WshShellオブジェクト
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
'データを貼り付けるシート名
Const sheetNM As String = "data"
'フォルダ名とファイル名を出力させるCSVファイル名を取得する
fldrFileNMExptTxt = ActiveWorkbook.Path & "\" & "data.csv"
'シートの行位置用カウンタの初期値を設定
rPos_cnt = 2
'シート存在確認フラグにfalse(存在しない)を設定する
shtExistFlg = False
'サブフォルダ含めて全てのフォルダ名・ファイル名を取得したいパス
getPath = Sheets("top").Range("searchpath").Value
'バイナリ データまたはテキストのストリームのインスタンスを生成する
Set st = New ADODB.Stream
'FileSystemObjectのインスタンスを生成する
Set fso = New FileSystemObject
'WshShellオブジェクトからインスタンスを生成する
Set wshObj = New WshShell
If Right(getPath, 1) <> "\" Then
'入力されたパスの末尾に「\」が付いていない場合に付ける
getPath = getPath & "\"
End If
If Sheets("top").OptionButtons("opb_allmatch").Value = 1 Then
'完全一致の場合
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & "*" & Range("searchStr").Value & "*" & """" & " > " & fldrFileNMExptTxt
ElseIf Sheets("top").OptionButtons("opb_partmatch").Value = 1 Then
'部分一致の場合
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & "*" & Range("searchStr").Value & "*" & """" & " > " & fldrFileNMExptTxt
ElseIf Sheets("top").OptionButtons("opb_fwdmatch").Value = 1 Then
'前方一致の場合
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & Range("searchStr").Value & "*" & """" & " > " & fldrFileNMExptTxt
ElseIf Sheets("top").OptionButtons("opb_rearmatch").Value = 1 Then
'後方一致の場合
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & "*" & Range("searchStr").Value & """" & " > " & fldrFileNMExptTxt
End If
'コマンドプロンプトで変数「cmdTxt」のコマンドを実行する
Call wshObj.Run("%ComSpec% /c " & cmdTxt, 1, WaitOnReturn:=True)
'フォルダ名とファイル名貼り付け用シート有無のチェック
For Each ws In Worksheets
If ws.Name = sheetNM Then
'シート「data」が存在している場合
shtExistFlg = True
End If
Next ws
If shtExistFlg = False Then
'シート「data」が存在しない場合
'フォルダ名・ファイル名を列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
.Name = sheetNM
End If
'listboxのデータの範囲設定をブランクに設定する
Sheets("top").ListBox1.ListFillRange = ""
With Sheets(sheetNM)
'AからD列をクリアする
.Columns("A:D").ClearContents
'データの項目名を設定する(ヘッダ設定)
.Range("A1").Value = "項番"
.Range("B1").Value = "パス"
.Range("C1").Value = "フォルダ名／ファイル名"
.Range("D1").Value = "種類"
'C列を「文字列」に設定する(例えば「0001」というフォルダは「1」となってしまうため)
.Columns("C").NumberFormatLocal = "@"
End With
With st
.Charset = "UTF-8" '文字セットにUTF-8を設定する
.Open 'streamを開く
.LoadFromFile fldrFileNMExptTxt 'フォルダ名とファイル名が出力されたファイルから読み込む
If fso.GetFile(fldrFileNMExptTxt).Size = 0 Then
'検索対象のデータが存在しない場合
'シート「data」のデータをlistboxに読み込ませる
Sheets("top").ListBox1.ListFillRange = sheetNM & "!" & Sheets(sheetNM).Range("A2", "D2").Address
MsgBox "検索データが存在しません。"
'処理終了
Exit Sub
End If
'Streamの末尾まで繰り返す
Do Until .EOS
'取り出したテキストを変数「buf」に格納する
buf = .ReadText(adReadLine)
'【条件：①または②のどちらかの条件が合致する場合】
'①「完全一致」が選択されている状態で、かつ、探したいフォルダ名やファイル名と、取得したフォルダ名やファイル名が一致する場合
'②「部分一致」「前方一致」「後方一致」が選択されている場合
If ( _
Sheets("top").OptionButtons("opb_allmatch").Value = 1 And _
UCase(Range("searchStr").Value) = UCase(WorksheetFunction.Replace(buf, 1, InStrRev(buf, "\"), "")) _
) Or _
Sheets("top").OptionButtons("opb_allmatch").Value <> 1 Then
'項番をA列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 1).Value = rPos_cnt - 1
'パスをB列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 2).Value = Left(buf, InStrRev(buf, "\"))
'フォルダ名またはファイル名をC列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 3).Value = WorksheetFunction.Replace(buf, 1, InStrRev(buf, "\"), "")
'フルパスがフォルダなのかファイルなのかを判定する(True：ファイル／False：フォルダ)
If fso.FileExists(buf) Then
'ファイルの場合
'ファイルを示す「F」をD列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 4).Value = "F"
Else
'フォルダの場合
'フォルダを示す「D」をD列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 4).Value = "D"
End If
rPos_cnt = rPos_cnt + 1
End If
DoEvents
Loop
'Streamの末尾まで処理が終わったので、streamを閉じる
.Close
End With
If Sheets(sheetNM).Range("A2").Value = "" Then
'シート「data」のデータをlistboxに読み込ませる
Sheets("top").ListBox1.ListFillRange = sheetNM & "!" & Sheets(sheetNM).Range("A2", "D2").Address
MsgBox "検索データが存在しません。"
'処理終了
Exit Sub
End If
With Sheets("top").ListBox1
'listboxのヘッダを表示するよう設定する
.ColumnHeads = True
'listboxを4列表示に設定する
.ColumnCount = 4
End With
'シート「data」のデータをlistboxに読み込ませる
Sheets("top").ListBox1.ListFillRange = sheetNM & "!" & Sheets(sheetNM).Range("A2", "D" & Sheets(sheetNM).Cells(1, 1).End(xlDown).Row).Address
'後処理
'フォルダ名とファイル名が出力されたファイルを削除する
Call fso.DeleteFile(fldrFileNMExptTxt, True)
Set wshObj = Nothing
Set st = Nothing
Set fso = Nothing
End Sub
コードの解説
注目すべきコード①
最初に見て頂きたいのは45行目から73行目です。
If Sheets("top").OptionButtons("opb_allmatch").Value = 1 Then
'完全一致の場合
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & "*" & Range("searchStr").Value & "*" & """" & " > " & fldrFileNMExptTxt
ElseIf Sheets("top").OptionButtons("opb_partmatch").Value = 1 Then
'部分一致の場合
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & "*" & Range("searchStr").Value & "*" & """" & " > " & fldrFileNMExptTxt
ElseIf Sheets("top").OptionButtons("opb_fwdmatch").Value = 1 Then
'前方一致の場合
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & Range("searchStr").Value & "*" & """" & " > " & fldrFileNMExptTxt
ElseIf Sheets("top").OptionButtons("opb_rearmatch").Value = 1 Then
'後方一致の場合
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & "*" & Range("searchStr").Value & """" & " > " & fldrFileNMExptTxt
End If
45行目で「完全一致」、52行目で「部分一致」、59行目で「前方一致」、66行目「後方一致」に合致するdirコマンドを実行する条件分け判定を行っています。
「完全一致」が選択されている場合
「完全一致」が選択されている場合に、
・探す対象のパスに「C:¥」を含めて配下全て
・探しているファイルが「test.csv」
の場合は次のコマンド文(例)が生成されます。
(本マクロのExcelファイルが「C:\work」に置かれている場合)
chcp 65001 | dir /b /s "C:\*test*" > C:\work\data.csv
※ここでは「部分一致」でdirコマンドを実行します。
部分一致でdirコマンドを実行し、探したいフォルダ名やファイル名と、取得したフォルダ名やファイル名が一致しているかを148行目で判定して完全に一致したものだけをListboxに表示させるようにします。
If ( _
Sheets("top").OptionButtons("opb_allmatch").Value = 1 And _
UCase(Range("searchStr").Value) = UCase(WorksheetFunction.Replace(buf, 1, InStrRev(buf, "\"), "")) _
) Or _
「部分一致」が選択されている場合
「部分一致」が選択されている場合に、
・探す対象のパスに「C:¥」を含めて配下全て
・「test」という文字列を含んでいるフォルダかファイルを探している
場合は次のコマンド文(例)が生成されます。
(本マクロのExcelファイルが「C:\work」に置かれている場合)
chcp 65001 | dir /b /s "C:\*test*" > C:\work\data.csv
「前方一致」が選択されている場合
「前方一致」が選択されている場合に、
・探す対象のパスに「C:¥」を含めて配下全て
・「test」という文字列を含んでいるフォルダかファイルを前方一致で探している
場合は次のコマンド文(例)が生成されます。
(本マクロのExcelファイルが「C:\work」に置かれている場合)
chcp 65001 | dir /b /s "C:\test*" > C:\work\data.csv
「後方一致」が選択されている場合
「後方一致」が選択されている場合に、
・探す対象のパスに「C:¥」を含めて配下全て
・「test」という文字列を含んでいるフォルダかファイルを後方一致で探している
場合は次のコマンド文(例)が生成されます。
(本マクロのExcelファイルが「C:\work」に置かれている場合)
chcp 65001 | dir /b /s "C:\*test" > C:\work\data.csv
注目すべきコード②
次に見て頂きたいのは76行目です。
'コマンドプロンプトで変数「cmdTxt」のコマンドを実行する
Call wshObj.Run("%ComSpec% /c " & cmdTxt, 1, WaitOnReturn:=True)
注目すべきコード①で紹介したコマンド文を76行目でRunメソッドの引数に設定してコマンドプロンプトでdirコマンドを実行しています。
なぜわざわざコマンドプロンプトを使っているのか(呼び出しているのか)というと、処理の高速化を図るためです。
大量のフォルダやファイルが存在する場合に、マクロだけでやろうとすると時間がかかりすぎるために高速化が実現できるコマンドプロンプトを使っています。
(※絶対にコマンドプロンプトを使わなければいけないというわけではありませんが、今回は手軽に使うことができるコマンドプロンプトを採用しました)
話がそれたので話を戻しますが、注目すべきコード①で紹介したコマンド文は、実は2つのコマンドを1行で実行しています。
2つのコマンドは次の通りです。(コマンド文は「部分一致」のコマンド文)
①chcp 65001
②dir /b /s “C:\*test*” > C:\work\data.csv
- ①のコマンドは、文字コードをUTF-8に設定するコマンドで、文字化けしないように文字コードをUTF-8に設定しています。
(文字コードをUTF-8に設定すると文字化けしない) - ②のコマンドは、dirコマンドを実行してファイル「data.csv」にディレクトリにあるファイルとサブディレクトリの一覧出力しています。
以上、上記のコマンドが実行されると、フォルダ名とファイル名が出力された「data.csv」というファイルが出力されます。
この「data.csv」をExcelマクロが読み込んでシートにフォルダ名とファイル名をセルに書き出していきます。
ちなみに、フォルダ名とファイル名を全てセルに書き出したら、必要がなくなるので221行目で削除します。
'フォルダ名とファイル名が出力されたファイルを削除する
Call fso.DeleteFile(fldrFileNMExptTxt, True)
注目すべきコード③
次に見て頂きたいのは119行目から123行目です。
With st
.Charset = "UTF-8" '文字セットにUTF-8を設定する
.Open 'streamを開く
.LoadFromFile fldrFileNMExptTxt 'フォルダ名とファイル名が出力されたファイルから読み込む
121行目で、文字コードをUTF-8に設定してフォルダ名とファイル名が出力された「data.csv」をExcelマクロが読み込むためにCharsetプロパティに「UTF-8」の文字列を設定しています。
次に122行目でOpenメソッドを実行し、123行目のLoadFromFile メソッドの引数に「data.csv」を設定して「data.csv」を読み込みます。
注目すべきコード④
次に見て頂きたいのは140行目から178行目です。
'Streamの末尾まで繰り返す
Do Until .EOS
'取り出したテキストを変数「buf」に格納する
buf = .ReadText(adReadLine)
'【条件：①または②のどちらかの条件が合致する場合】
'①「完全一致」が選択されている状態で、かつ、探したいフォルダ名やファイル名と、取得したフォルダ名やファイル名が一致する場合
'②「部分一致」「前方一致」「後方一致」が選択されている場合
If ( _
Sheets("top").OptionButtons("opb_allmatch").Value = 1 And _
UCase(Range("searchStr").Value) = UCase(WorksheetFunction.Replace(buf, 1, InStrRev(buf, "\"), "")) _
) Or _
Sheets("top").OptionButtons("opb_allmatch").Value <> 1 Then
'項番をA列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 1).Value = rPos_cnt - 1
'パスをB列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 2).Value = Left(buf, InStrRev(buf, "\"))
'フォルダ名またはファイル名をC列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 3).Value = WorksheetFunction.Replace(buf, 1, InStrRev(buf, "\"), "")
'フルパスがフォルダなのかファイルなのかを判定する(True：ファイル／False：フォルダ)
If fso.FileExists(buf) Then
'ファイルの場合
'ファイルを示す「F」をD列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 4).Value = "F"
Else
'フォルダの場合
'フォルダを示す「D」をD列に設定する
Sheets(sheetNM).Cells(rPos_cnt, 4).Value = "D"
End If
143行目では、1行取り出して変数「buf」に格納しています。この1行はフルパスになります。
155行目ではlistbox1の1列目に設定する項番をExcelのシートのA列に、158行目ではlistbox1の2列目に設定するパスをExcelのシートのB列に、161行目ではlistbox1の3列目に設定するフォルダ名またはファイル名をExcelのシートのC列に設定します。
164行目では、変数「buf」の値がフォルダ名またはファイル名なのかを判定し、ファイルの場合は169行目でlistbox1の4列目に設定するファイルを示す「F」の文字をExcelのシートのD列に、フォルダの場合は176行目でlistbox1の4列目に設定するフォルダを示す「D」の文字をExcelのシートのD列に設定します。
注目すべきコード⑤
次に見て頂きたいのは205行目から213行目です。
With Sheets("top").ListBox1
'listboxのヘッダを表示するよう設定する
.ColumnHeads = True
'listboxを4列表示に設定する
.ColumnCount = 4
End With
ここではListbox1のヘッダに関する設定を行います。
208行目では、listboxのヘッダを表示するよう設定し、211行目ではlistbox1を4列表示に設定します。
注目すべきコード⑥
次に見て頂きたいのは216行目です。
'シート「data」のデータをlistboxに読み込ませる
Sheets("top").ListBox1.ListFillRange = sheetNM & "!" & Sheets(sheetNM).Range("A2", "D" & Sheets(sheetNM).Cells(1, 1).End(xlDown).Row).Address
216行目では、ListFillRangeプロパティにシート「data」の値を設定することで、シート「data」の値をListbox1に読み込ませて表示させます。
※変数「sheetNM」は、シート名の文字列「data」が格納されています。
マクロでパソコン内からフォルダやファイルを探し出した結果
本マクロを実行した結果、マクロでパソコン内からフォルダやファイルが探し出せたことが確認できました。
・探す対象のパスに「C:\Program Files\WindowsPowerShell」
・検索する対象を「resources」で完全一致を指定
・探す対象のパスに「C:\Program Files\WindowsPowerShell」
・検索する対象を「.dll」で部分一致を指定
【注意】参照設定が必要です
一つ注意点があるのですが、先ほどのコードを動かすには参照設定が必要です。
参照設定の一覧(下の画像を参考)から次の項目(ライブラリ)にチェックを付けて「OK」ボタンをクリックします。
- Microsoft ActiveX Data Objects 2.8 Library(msado28.tlb)
- Windows Script Host Object Model(wshom.ocx)
なぜ必要かというと、先ほどのコードの10行目の「ADODB.Stream」というオブジェクトが「msado28.tlb」というファイルを、先ほどのコードの11行目の「WshShell」と12行目の「FileSystemObject」というオブジェクトが「wshom.ocx」というファイルを参照するからです。
Dim st As ADODB.Stream 'バイナリ データまたはテキストのストリームのインスタンス用変数
Dim wshObj As WshShell 'WshShellオブジェクト
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
この参照設定をしないと下の画像のエラーが出ますので必ず行う必要があります。
ここでは「msado28.tlb」と「wshom.ocx」とは何者かについては記事の本題から逸れてしまうので詳細は割愛しますが、マクロで「ADODB.Stream」「WshShell」「FileSystemObject」というオブジェクトを使う場合は参照設定しないと動かない、程度に思って頂ければと思います。
最後に
本記事では、マクロでパソコン内からフォルダやファイルを探し出す方法についてご説明しました。
パソコン内に置いたファイルがどこにあるのかわからなくなった時に参考にしてみてくださいね。
プログラミングのスキルを習得するなら
プログラミングのスキルを習得したい、今のスキルをもっと高めたい、そう考えているなら「プログラミングスクール」がおすすめです。
プログラミングのスキルの基礎を身につけるなら「TechAcademy」で1週間の無料体験があるので、これで「プログラミングの基礎」を学ぶのにおすすめですよ。
