この記事では、Excelのマクロ・コマンドプロンプトを使ってパソコン内のフォルダとファイルを検索する方法についてご説明します。
【動画】Excelのマクロ・コマンドプロンプトを使ってパソコン内のフォルダとファイルを検索する実際の動き
本題に入る前に、まずは次の動画をご覧ください。
パソコン内のフォルダ名とファイル名をコマンドプロンプトで取得後、Excelのシートに貼り付けてその中からSQL文で検索・抽出してListboxに表示させています。
なお動画内で行っているパソコン内のフォルダ名とファイル名の検索は、「完全一致」「部分一致」「前方一致」「後方一致」の4つの検索方法で行っています。
Excelのマクロ・コマンドプロンプトを使ってパソコン内のフォルダとファイルを検索する処理の流れ
今回紹介するマクロの処理の流れをここで整理します。
処理の流れ
取得したフォルダ・ファイル一覧はCSVに出力します。
Excelファイルの例
今回は次のExcelファイルを作成しました。
配置されているコントロールやセルの名前は次の通りです。
searchpath
フォルダやファイルを探す対象のフォルダパスを指定するセルに、「searchpath」という名前を付けます。
例えば、Cドライブ配下全てでフォルダやファイルを検索する場合は「c:\」または「c:」と入力します。
searchStr
探したいフォルダ名やファイル名、もしくは探したいフォルダやファイルの文字列の一部を入力するセルに「searchStr」という名前を付けます。
このセルに探したいフォルダ名やファイル名、もしくは探したいフォルダやファイルの文字列の一部を入力して検索します。
例えば、「work」というフォルダ名や「test.txt」というファイル名を探す場合は、このセルに「work」または「test.txt」と入力し、検索すると検索結果が表示されます。
また、探したいフォルダやファイルの文字列の一部だけで検索する場合、例えば「temp」という文字列だけで探す場合は「temp」と入力します。(※部分一致や前方・後方一致などを選んで検索した場合)
文字列の一部だけで検索した場合は文字列を含むフォルダやファイルが検索結果に表示されます。
opb_allmatch(フォームコントロール)
フォルダやファイルを「完全一致」で検索するよう設定するオプションボタンです。
フォルダ名やファイル名と完全に一致するフォルダやファイルを検索します。
完全に一致しないと検索がヒットしません。
opb_partmatch(フォームコントロール)
フォルダやファイルを「部分一致」で検索するよう設定するオプションボタンです。
フォルダ名やファイル名の一部の文字列だけでフォルダやファイルを検索します。
opb_fwdmatch(フォームコントロール)
フォルダやファイルを「前方一致」で検索するよう設定するオプションボタンです。
フォルダ名やファイル名の前の文字から順に条件に一致するフォルダやファイルを検索します。
opb_rearmatch(フォームコントロール)
フォルダやファイルを「後方一致」で検索するよう設定するオプションボタンです。
フォルダ名やファイル名の後ろの文字から順に条件に一致するフォルダやファイルを検索します。
listbox1(ActiveXコントロール)
listboxで検索結果を表示させます。
コードの例
Excelのマクロのコード(例)
Option Explicit
Private Sub btn_getDirFileList_Click()
Dim buf As String '一時的な値の格納先変数
Dim wkAry() As String '一時的な値の格納先配列
Dim getPath As String 'サブフォルダ含めて全てのフォルダ名とファイル名を取得したいパス
Dim cmdTxt As String 'コマンドプロンプトのコード用変数
Dim shtNMCnt As Integer 'シート名用カウンタ
Dim rPos_cnt As Long 'シートの行位置用カウンタ
Dim ws As Worksheet 'Worksheet用変数
Dim fldrFileNMExptTxt As String 'フォルダ名とファイル名が出力されたファイル名
Dim wshObj As WshShell 'WshShellオブジェクト
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
Dim st As ADODB.Stream 'バイナリ データまたはテキストのストリームのインスタンス用変数
Dim oCon As ADODB.Connection 'ADODB.Connectionオブジェクトのインスタンス用変数
Dim rs As ADODB.Recordset 'レコードセット用変数
Dim workSheetExistChk As Boolean 'シート「work」の存在チェックフラグ
Dim lastRow As Long '最終行
Dim rVal As Variant '取得したデータ格納用変数
Dim sqlStr As String 'SQL文
Dim rng As Range 'Rangeオブジェクト格納用変数
Dim rDataExistFlg As Boolean 'データ有無判定
'1つのシートに貼り付けるデータの最大件数
Const rowMAXNum As Long = 1048576
'出力ファイルを一意にするため、年月日時分秒をファイル名に付ける
fldrFileNMExptTxt = "data.csv"
'シートの行位置用カウンタの初期値を設定
rPos_cnt = 2
'シート名用カウンタの初期値を設定
shtNMCnt = 0
'シート「work」の存在チェックフラグを初期化する
workSheetExistChk = False
'データがあるのでデータ有無判定フラグを初期化する
rDataExistFlg = 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
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & """" & " > " & ActiveWorkbook.Path & "\" & fldrFileNMExptTxt & " /B"
'コマンドプロンプトで変数「cmdTxt」のコマンドを実行する
Call wshObj.Run("%ComSpec% /c " & cmdTxt, 1, WaitOnReturn:=True)
'フォルダ名とファイル名貼り付け用シート有無のチェック
For Each ws In Worksheets
If ws.Name = "data" & CStr(shtNMCnt + 1) Then
'フォルダ名とファイル名貼り付け用シートが存在する場合
'確認ダイアログを非表示にする
Application.DisplayAlerts = False
'フォルダ名とファイル名貼り付け用シートを選択する
Sheets("data" & CStr(shtNMCnt + 1)).Select
'フォルダ名とファイル名貼り付け用シートを削除する
ActiveWindow.SelectedSheets.Delete
'確認ダイアログを表示可にする
Application.DisplayAlerts = True
shtNMCnt = shtNMCnt + 1
ElseIf ws.Name = "work" Then
'シート「work」の存在チェックフラグにTrueを設定する
workSheetExistChk = True
'シート「work」のセルをクリアする
Worksheets(ws.Name).Cells.Clear
End If
Next ws
'シート名用カウンタを0に初期化する
shtNMCnt = 0
If workSheetExistChk = False Then
'シート「work」が存在しない場合
'フォルダ名・ファイル名を列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
.Name = "work"
Else
'シート「work」が存在する場合
With Worksheets("work")
'シート「work」をクリアする
.Cells.Clear
'C列のセルの書式を文字列に設定する
.Columns("C").NumberFormatLocal = "@"
End With
End If
'シート名用カウンタを0に初期化する
shtNMCnt = 0
'フォルダ名・ファイル名を列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
.Name = "data" & CStr(shtNMCnt + 1)
With Sheets("data" & CStr(shtNMCnt + 1))
'1行目に項目を設定する
.Range("A1").Value = "パス"
.Range("B1").Value = "フォルダ名／ファイル名"
'A列に色を付ける
.Range("A1:B1").Interior.Color = RGB(252, 228, 214)
'B列を「文字列」に設定する
.Columns("B").NumberFormatLocal = "@"
End With
With st
.Charset = "UTF-8" '文字セットにUTF-8を設定する
.Open 'streamを開く
.LoadFromFile ActiveWorkbook.Path & "\" & _
fldrFileNMExptTxt 'フォルダ名とファイル名が出力されたファイルから読み込む
'Streamの末尾まで繰り返す
Do Until .EOS
'取り出したテキストを変数「buf」に格納する
buf = .ReadText(adReadLine)
'フルパスから「\」を区切り文字としてフォルダ名・ファイル名を配列に格納する
wkAry = Split(buf, "\")
'フルパスからパスを切り出してA列に設定する
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 1).Value = Left(buf, Len(buf) - Len(wkAry(UBound(wkAry))) - 1)
'フルパスからフォルダ名またはファイル名を切り出してB列に設定する
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 2).Value = wkAry(UBound(wkAry))
'フルパスがフォルダなのかファイルなのかを判定する(Ture：ファイル／False：フォルダ)
If fso.FileExists(buf) Then
'ファイルの場合
'B列のセルに色を付ける(※本マクロではファイルの場合は黄色を付けるようにしています)
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 2).Interior.Color = RGB(255, 255, 200)
Else
'フォルダの場合
'B列のセルに色を付ける(※本マクロではフォルダの場合は緑色を付けるようにしています)
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 2).Interior.Color = RGB(198, 224, 180)
End If
rPos_cnt = rPos_cnt + 1
'Excelの行数を超える場合
If (rPos_cnt Mod rowMAXNum) = 0 Then
shtNMCnt = shtNMCnt + 1
'(Excelの行数を超えるので)フォルダ名・ファイル名を列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
.Name = "data" & CStr(shtNMCnt + 1)
With Sheets("data" & CStr(shtNMCnt + 1))
'1行目に項目を設定する
.Range("A1").Value = "パス"
.Range("B1").Value = "フォルダ名／ファイル名"
'A1とB1のセルに色を付ける
.Range("A1:B1").Interior.Color = RGB(252, 228, 214)
'B列を「文字列」に設定する
.Columns("B").NumberFormatLocal = "@"
End With
'シートの行位置用カウンタの初期値を設定(シートを追加したのでまた2行目からカウントする)
rPos_cnt = 2
End If
DoEvents
Loop
'Streamの末尾まで処理が終わったので、streamを閉じる
.Close
End With
With Worksheets("work")
'1行目に項目を設定する
.Range("A1").Value = "項番"
.Range("B1").Value = "パス"
.Range("C1").Value = "フォルダ名／ファイル名"
'A列に色を付ける
.Range("A1:C1").Interior.Color = RGB(252, 228, 214)
'C列のセルを「文字列」に設定する
.Columns("C").NumberFormatLocal = "@"
End With
'インスタンスの生成
Set oCon = New ADODB.Connection
With oCon
'接続情報の取得
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source = " & ThisWorkbook.FullName & _
";Extended Properties =Excel 12.0;"
'データソースへの接続を開く
.Open
End With
Set rs = New ADODB.Recordset
'最終行に1を設定する(処理の最初は1)
lastRow = 2
'シート名用カウンタの初期値を設定
shtNMCnt = 0
'フォルダ名とファイル名貼り付け用シート有無のチェック
For Each ws In Worksheets
If ws.Name = "data" & CStr(shtNMCnt + 1) Then
'データが書き込まれたシートの場合
'データを取得するSQL文を作成する
sqlStr = "select"
sqlStr = sqlStr & " [" & ws.Range("A1").Value & "]"
sqlStr = sqlStr & " ,[" & ws.Range("B1").Value & "]"
sqlStr = sqlStr & " from "
sqlStr = sqlStr & " [" & ws.Name & "$]"
sqlStr = sqlStr & " where "
'「検索対象のフォルダ／ファイル」の条件をSQL文に付与する
If Sheets("top").OptionButtons("opb_allmatch").Value = 1 Then
'完全一致の場合
'条件(完全一致で取得)
sqlStr = sqlStr & " [" & ws.Range("B1").Value & "]" & " = '" & Range("searchStr").Value & "'"
ElseIf Sheets("top").OptionButtons("opb_partmatch").Value = 1 Then
'部分一致の場合
'条件(部分一致で取得)
sqlStr = sqlStr & " [" & ws.Range("B1").Value & "]" & " like '%" & Range("searchStr").Value & "%'"
ElseIf Sheets("top").OptionButtons("opb_fwdmatch").Value = 1 Then
'前方一致の場合
'条件(前方一致で取得)
sqlStr = sqlStr & " [" & ws.Range("B1").Value & "]" & " like '" & Range("searchStr").Value & "%'"
ElseIf Sheets("top").OptionButtons("opb_rearmatch").Value = 1 Then
'後方一致の場合
'条件(後方一致で取得)
sqlStr = sqlStr & " [" & ws.Range("B1").Value & "]" & " like '%" & Range("searchStr").Value & "'"
End If
rs.Open sqlStr, oCon, adOpenStatic
If rs.RecordCount > 0 Then
'レコード件数が1件以上ある場合
'データをシート「work」に貼り付ける
Sheets("work").Range("B" & lastRow).CopyFromRecordset rs
'データがあるのでデータ有無判定フラグをTrueにする
rDataExistFlg = True
End If
'最終行(+1)を取得する
lastRow = Worksheets("work").Cells(Rows.Count, 1).End(xlUp).Row + 1
'セルの名前用カウンタを+1する
shtNMCnt = shtNMCnt + 1
rs.Close
End If
Next ws
If rDataExistFlg = False Then
'検索データが存在しない場合
With ListBox1
'Listboxの表示(ListFillRangeプロパティ)をクリアする
.ListFillRange = "work" & "!$A$2:$C$2"
'ヘッダを表示させる
.ColumnHeads = True
'Listboxの列数を設定する
.ColumnCount = 3
'Listboxの列の幅を設定する(※お好きな値で設定してください)
.ColumnWidths = "50;160;800"
End With
Sheets("top").Select
MsgBox "検索データがありません。"
'処理を終了する
Exit Sub
End If
'項番を設定するセルの範囲を指定する
Set rng = Sheets("work").Range("A2:A" & Worksheets("work").Cells(Rows.Count, 2).End(xlUp).Row)
'項番を設定する
rng.Formula = "=row()-1"
With Worksheets("top").ListBox1
'Listboxの表示するデータのセル範囲を指定する
.ListFillRange = "work" & "!$A$2:$C$" & Worksheets("work").Cells(Rows.Count, 1).End(xlUp).Row
'ヘッダを表示させる
.ColumnHeads = True
'Listboxの列数を設定する
.ColumnCount = 3
'Listboxの列の幅を設定する(※お好きな値で設定してください)
.ColumnWidths = "50;360;800"
End With
If fso.FileExists(ActiveWorkbook.Path & "\" & fldrFileNMExptTxt) Then
'ファイルが存在している場合
'フォルダ名とファイル名が出力されたファイルを削除する
Call fso.DeleteFile(ActiveWorkbook.Path & "\" & fldrFileNMExptTxt, True)
End If
'後処理
Set rs = Nothing
Set oCon = Nothing
Set st = Nothing
Set fso = Nothing
Sheets("top").Select
MsgBox "完了"
End Sub
コードの解説
注目すべきコード①
最初に見て頂きたいのは63行目から66行目です。
'実行するコマンド：dirコマンドでフルパスをCSVファイルに書き出す
cmdTxt = "chcp 65001 | dir /b /s " & """" & getPath & """" & " > " & ActiveWorkbook.Path & "\" & fldrFileNMExptTxt
'コマンドプロンプトで変数「cmdTxt」のコマンドを実行する
Call wshObj.Run("%ComSpec% /c " & cmdTxt, 1, WaitOnReturn:=True)
以上のコードは、コマンドプロンプトを呼び出してサブフォルダ含めて全てのフォルダ名とファイル名を取得したいパスをCSVファイルに書き出す処理です。
63行目でフォルダ名とファイル名を出力させるCSVファイルの出力を行うコマンド文(dirコマンド)を変数「cmdTxt」に格納し、66行目でそのコマンドをコマンドプロンプトで実行します。
なぜわざわざコマンドプロンプトを使っているのか(呼び出しているのか)というと、処理の高速化を図るためです。
大量のフォルダやファイルが存在する場合に、マクロだけでやろうとすると時間がかかりすぎるために高速化が実現できるコマンドプロンプトを使っています。
(※絶対にコマンドプロンプトを使わなければいけないというわけではありませんが、今回は手軽に使うことができるコマンドプロンプトを採用しました)
例えば、私のパソコンのCドライブ配下にはサブフォルダ含めて全てのフォルダとファイルの数はファイル数が120万超、フォルダー数が270万近くありますが、これほどの数をExcelマクロだけでシートに書き出そうとすると何時間もかかってしまいます。
これだけの大量にあるフォルダとファイルを取得してシートに書き出したい場合に、マクロだけで行うのは処理時間を考えると現実的ではないです。
一方、コマンドプロンプトを呼び出してdirコマンドを使い(Cドライブ配下の)、ファイル名とサブディレクトリ名を一覧出力すると(私のパソコンでは)40分弱で終わりました。(完了するまでの時間はPCのスペックに左右されますが)
ただし40分という時間が長すぎてイヤという場合は、DB製品(AccessやSQL Severなど)を使う方が速いので、そちらを使った方が良いです。
【ExcelVBA】Excelのマクロ・コマンドプロンプト・Accessを使ってパソコン内のフォルダとファイルを検索する
【ExcelVBA】マクロ・コマンドプロンプト・SQL Serverのストアドプロシージャを使ってパソコン内のフォルダとファイルを検索する
ちなみに、dirコマンド実行後に出力されるフォルダとファイルの一覧(CSVファイル)は、Excelのシートに書き出されます。
なお、コマンドプロンプトで実行するコマンド文は、実は2つのコマンドを1行で実行しています。
2つのコマンド(例)は次の通りです。(コマンド文は「部分一致」のコマンド文)
①chcp 65001
②dir /b “C:\work\” > C:\work\10_勉強\10_VBA関連\0142\data.csv
- ①のコマンドは、文字コードをUTF-8に設定するコマンドで、文字化けしないように文字コードをUTF-8に設定しています。
(文字コードをUTF-8に設定すると文字化けしない) - ②のコマンドは、dirコマンドを実行して、サブフォルダ含めて全ファイルと全フォルダの一覧をファイル「data.csv」に出力しています。
以上、上記のコマンドが実行されると、フォルダ名とファイル名が出力された「data.csv」というファイルが出力されます。
ちなみに、フォルダ名とファイル名を全てセルに書き出したら、必要がなくなるので394行目で削除します。
'フォルダ名とファイル名が出力されたファイルを削除する
Call fso.DeleteFile(ActiveWorkbook.Path & "\" & fldrFileNMExptTxt, True)
注目すべきコード②
次に見て頂きたいのは149行目から169行目です。
With st
.Charset = "UTF-8" '文字セットにUTF-8を設定する
.Open 'streamを開く
.LoadFromFile ActiveWorkbook.Path & "\" & _
fldrFileNMExptTxt 'フォルダ名とファイル名が出力されたファイルから読み込む
'Streamの末尾まで繰り返す
Do Until .EOS
'取り出したテキストを変数「buf」に格納する
buf = .ReadText(adReadLine)
'フルパスから「\」を区切り文字としてフォルダ名・ファイル名を配列に格納する
wkAry = Split(buf, "\")
'フルパスからパスを切り出してA列に設定する
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 1).Value = Left(buf, Len(buf) - Len(wkAry(UBound(wkAry))) - 1)
'フルパスからフォルダ名またはファイル名を切り出してB列に設定する
Sheets("data" & CStr(shtNMCnt + 1)).Cells(rPos_cnt, 2).Value = wkAry(UBound(wkAry))
151行目で、文字コードをUTF-8に設定してフォルダ名とファイル名が出力された「data.csv」をExcelマクロが読み込むためにCharsetプロパティに「UTF-8」の文字列を設定しています。
次に152行目でOpenメソッドを実行し、153行目のLoadFromFile メソッドの引数に「data.csv」を設定して「data.csv」を読み込みます。
157行目のDoループで、読み込んだ「data.csv」の行数分処理を繰り返します。
160行目では、1行取り出して変数「buf」に格納しています。この1行はフルパスになります。
取り出した1行(フルパス)から「\」を区切り文字としてフォルダ名・ファイル名を配列「wkAry」に格納し、フルパスからパスとフォルダ名またはファイル名を取り出します。
パスは166行目でA列のセルに、フォルダ名またはファイル名は169行目でB列のセルに設定します。
注目すべきコード③
次に見て頂きたいのは191行目から197行目です。
'Excelの行数を超える場合
If (rPos_cnt Mod rowMAXNum) = 0 Then
shtNMCnt = shtNMCnt + 1
'(Excelの行数を超えるので)フォルダ名・ファイル名を列挙するためのシートを新規作成する
Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
.Name = "data" & CStr(shtNMCnt + 1)
フォルダとファイルの数がExcelの最大行数(1,048,576行)を超える場合は、新たにシートを追加します。
最大行数を超えるかを191行目で判定し、もし超える場合は196行目で新たにシートを作成します。
新規で作成された2つ目のシートには、1,048,576件目以降のフォルダ名またはファイル名が書き出されます。
注目すべきコード④
次に見て頂きたいのは44行目です。
'サブフォルダ含めて全てのフォルダ名・ファイル名を取得したいパス
getPath = Sheets("top").Range("searchpath").Value
44行目で、サブフォルダ含めて全てのフォルダ名とファイル名を取得するパスを指定しています。
今回の例でお見せしたExcelでは、セル「searchpath」にフォルダ名とファイル名を取得するパスを入力します。
例えばセル「searchpath」に「C:¥」と入力してマクロを実行すると、「C:¥」配下全てのフォルダおよびファイルを検索対象にします。
注目すべきコード⑤
次に見て頂きたいのは273行目から310行目です。
'データを取得するSQL文を作成する
sqlStr = "select"
sqlStr = sqlStr & " [" & ws.Range("A1").Value & "]"
sqlStr = sqlStr & " ,[" & ws.Range("B1").Value & "]"
sqlStr = sqlStr & " from "
sqlStr = sqlStr & " [" & ws.Name & "$]"
sqlStr = sqlStr & " where "
'「検索対象のフォルダ／ファイル」の条件をSQL文に付与する
If Sheets("top").OptionButtons("opb_allmatch").Value = 1 Then
'完全一致の場合
'条件(完全一致で取得)
sqlStr = sqlStr & " [" & ws.Range("B1").Value & "]" & " = '" & Range("searchStr").Value & "'"
ElseIf Sheets("top").OptionButtons("opb_partmatch").Value = 1 Then
'部分一致の場合
'条件(部分一致で取得)
sqlStr = sqlStr & " [" & ws.Range("B1").Value & "]" & " like '%" & Range("searchStr").Value & "%'"
ElseIf Sheets("top").OptionButtons("opb_fwdmatch").Value = 1 Then
'前方一致の場合
'条件(前方一致で取得)
sqlStr = sqlStr & " [" & ws.Range("B1").Value & "]" & " like '" & Range("searchStr").Value & "%'"
ElseIf Sheets("top").OptionButtons("opb_rearmatch").Value = 1 Then
'後方一致の場合
'条件(後方一致で取得)
sqlStr = sqlStr & " [" & ws.Range("B1").Value & "]" & " like '%" & Range("searchStr").Value & "'"
End If
以上のコードは、「注目すべきコード②」でExcelのシートに書き出されたフォルダ名およびファイル名から、特定したいフォルダ名またはファイル名を検索・抽出するSelect文を作成するコードです。
Excelのシートのデータに対してデータを抽出する方法はいくつかありますが、今回のマクロではSQLのSelect文を使ってデータを抽出する方式を採用しています。
そのselect文を作成するため、上記のコードを実行します。
select文のフィールド名は274行目と275行目で、テーブル名は277行目で指定しています。
条件指定は278行目から310行目で指定します。
Select文の例
コードだけではSelect文が分かりづらいと思うので、Select文の例を以下にお見せします。
「完全一致」
シート「data1」のB列の値から「test.csv」というファイルを検索する場合
select
[パス],
[フォルダ名／ファイル名]
from
[data1$]
where
[フォルダ名／ファイル名] = 'temp.txt'
※シート「data1」のB列に対して検索したいデータが出力されていて、セルA1には「パス」、セルB1には「フォルダ名／ファイル名」という値の場合
「部分一致」
シート「data1」のB列の値から「temp」という文字列を含んでいるフォルダ名かファイル名を検索する場合
select
[パス],
[フォルダ名／ファイル名]
from
[data1$]
where
[フォルダ名／ファイル名] like '%temp%'
※シート「data1」のB列に対して検索したいデータが出力されていて、セルA1には「パス」、セルB1には「フォルダ名／ファイル名」という値の場合
「前方一致」
シート「data1」のB列の値から、「temp」という文字列を含んでいるフォルダかファイルを前方一致で探している場合
select
[パス],
[フォルダ名／ファイル名]
from
[data1$]
where
[フォルダ名／ファイル名] like 'temp%'
※シート「data1」のB列に対して検索したいデータが出力されていて、セルA1には「パス」、セルB1には「フォルダ名／ファイル名」という値の場合
「後方一致」
シート「data1」のB列の値から、「temp」という文字列を含んでいるフォルダかファイルを後方一致で探している場合
select
[パス],
[フォルダ名／ファイル名]
from
[data1$]
where
[フォルダ名／ファイル名] like '%temp'
※シート「data1」のB列に対して検索したいデータが出力されていて、セルA1には「パス」、セルB1には「フォルダ名／ファイル名」という値の場合
注目すべきコード⑥
次に見て頂きたいのは312行目です。
rs.Open sqlStr, oCon, adOpenStatic
作成したSelect文をOpenメソッドの引数に指定して実行することで、データの抽出が行われます。
注目すべきコード⑦
次に見て頂きたいのは314行目から324行目です。
If rs.RecordCount > 0 Then
'レコード件数が1件以上ある場合
'データをシート「work」に貼り付ける
Sheets("work").Range("B" & lastRow).CopyFromRecordset rs
'データがあるのでデータ有無判定フラグをTrueにする
rDataExistFlg = True
End If
以上のコードは、SQLのSelect文で抽出したデータをシート「work」に貼り付ける処理のコードです。
抽出したデータが存在する場合は、抽出したデータをシート「work」に貼り付けます。
データの貼り付けは319行目のCopyFromRecordsetメソッドを使います。
貼り付けるセルの位置は指定することができ、上記コードではB列のセルに貼り付けています。(行位置はlastRowの値で指定しています)
また、322行目ではデータ件数判定に使うためのフラグ「rDataExistFlg」にTrueを設定します。
上記コードはレコード件数が1件以上ある場合のコードなので、ここではフラグ「rDataExistFlg」にTrueを設定しておきます。
(データがない場合は「rDataExistFlg」がFalseのまま。データがない時のListboxに表示処理はこの後の「注目すべきコード⑧」で説明します)
注目すべきコード⑧
次に見て頂きたいのは338行目から365行目です。
If rDataExistFlg = False Then
'検索データが存在しない場合
With ListBox1
'Listboxの表示(ListFillRangeプロパティ)をクリアする
.ListFillRange = "work" & "!$A$2:$C$2"
'ヘッダを表示させる
.ColumnHeads = True
'Listboxの列数を設定する
.ColumnCount = 3
'Listboxの列の幅を設定する(※お好きな値で設定してください)
.ColumnWidths = "50;160;800"
End With
Sheets("top").Select
MsgBox "検索データがありません。"
'処理を終了する
Exit Sub
End If
以上のコードは、検索したフォルダまたはファイルが存在しなかった場合に行う処理です。
もしフォルダまたはファイルが存在しない場合は、345行目でListboxのデータ表示部は何も表示させずにヘッダだけ表示させ、360行目でデータがないことの旨のメッセージボックスを表示させ363行目でマクロを終了します。
注目すべきコード⑨
次に見て頂きたいのは368行目から371行目です。
'項番を設定するセルの範囲を指定する
Set rng = Sheets("work").Range("A2:A" & Worksheets("work").Cells(Rows.Count, 2).End(xlUp).Row)
'項番を設定する
rng.Formula = "=row()-1"
以上のコードは、シート「work」のA列に項番を設定する処理です。
368行目では項番を設定するセルの範囲を取得しています。
371行目では項番を設定しています。(Excelのrow関数を使用しています)
注目すべきコード⑩
次に見て頂きたいのは373行目から387行目です。
With Worksheets("top").ListBox1
'Listboxの表示するデータのセル範囲を指定する
.ListFillRange = "work" & "!$A$2:$C$" & Worksheets("work").Cells(Rows.Count, 1).End(xlUp).Row
'ヘッダを表示させる
.ColumnHeads = True
'Listboxの列数を設定する
.ColumnCount = 3
'Listboxの列の幅を設定する(※お好きな値で設定してください)
.ColumnWidths = "50;360;800"
End With
以上のコードは、Listbox1のヘッダに関する設定を行います。
376行目ではListFillRangeプロパティを使ってListboxにデータを表示させます。
ListFillRangeプロパティに、Listboxに表示させるデータが存在するシート名とセルの範囲を指定します。
379行目では、listboxのヘッダを表示するよう設定し、382行目ではlistboxを4列表示に、385行目ではListboxの列の幅を設定します。
動作確認
マクロを実行した実行結果は記事内の次のコントロールの内容をご覧ください(クリックすると記事内の対象の説明に飛びます。)
- 「完全一致」(のオプションボタン(opb_allmatch))が選択された状態でマクロを実行した場合
- 「部分一致」(のオプションボタン(opb_partmatch))が選択された状態でマクロを実行した場合
- 「前方一致」(のオプションボタン(opb_fwdmatch))が選択された状態でマクロを実行した場合
- 「後方一致」(のオプションボタン(opb_rearmatch))が選択された状態でマクロを実行した場合
【注意】参照設定が必要です
一つ注意点があるのですが、先ほどのコードを動かすには参照設定が必要です。
参照設定の一覧(下の画像を参考)から次の項目(ライブラリ)にチェックを付けて「OK」ボタンをクリックします。
- Windows Script Host Object Model(wshom.ocx)
- Microsoft ActiveX Data Objects 2.8 Library(msado28.tlb)
なぜ必要かというと、Excelのマクロのコードの13行目の「WshShell」と14行目の「FileSystemObject」というオブジェクトが「wshom.ocx」というファイルを、15行目から17行目の「ADODB.Stream」「ADODB.Connection」「ADODB.Recordset」というオブジェクトが「msado28.tlb」というファイルを参照するからです。
Dim wshObj As WshShell 'WshShellオブジェクト
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
Dim st As ADODB.Stream 'バイナリ データまたはテキストのストリームのインスタンス用変数
Dim oCon As ADODB.Connection 'ADODB.Connectionオブジェクトのインスタンス用変数
Dim rs As ADODB.Recordset 'レコードセット用変数
この参照設定をしないと下の画像のエラーが出ますので必ず行う必要があります。
ここでは「wshom.ocx」と「msado28.tlb」とは何者かについては記事の本題から逸れてしまうので詳細は割愛しますが、マクロで「ADODB.Stream」「FileSystemObject」「ADODB.Stream」「ADODB.Connection」「ADODB.Recordset」というオブジェクトを使う場合は参照設定しないと動かない、程度に思って頂ければと思います。
最後に
本記事では、Excelのマクロ・コマンドプロンプトを使ってパソコン内のフォルダとファイルを検索する方法についてご説明しました。
処理の流れをおさらいしておくと次の通りです。
取得したフォルダ・ファイル一覧はCSVに出力します。
以上で、検索したパソコン内のフォルダとファイルを見つけることができます。
サブフォルダ含めて全てのフォルダ名とファイル名を取得したい場合は参考にしてみてくださいね。
プログラミングのスキルを習得するなら
プログラミングのスキルを習得したい、今のスキルをもっと高めたい、そう考えているなら「プログラミングスクール」がおすすめです。
プログラミングのスキルの基礎を身につけるなら「TechAcademy」で1週間の無料体験があるので、これで「プログラミングの基礎」を学ぶのにおすすめですよ。
