ドライブ全体をファイル検索する(FileSearchオブジェクト)|Excel VBA |
次のサンプルは、指定したドライブ全体からすべてのExcelファイルを検索します。
見つかったファイルのパスを含むファイル名、ファイルサイズ、更新日付をアクティブシートに出力します。
ただし、FileSearchオブジェクトはExcel 2003までのバージョンにしかないので、Excel 2007以降のバージョンでは使用できません。
Excel 2007以降は「サブフォルダを含めてファイル一覧を取得する(WSHでDirコマンドを実行)」を参照してください。
また、本記事では1件ずつワークシートに出力していますが、上記の記事では配列を使って一括出力しています。処理速度を向上させたい場合も参考にしてください。
Sub Sample()
Dim i As Long
Dim TargetDrive As String
' 画面更新をとめる
Application.ScreenUpdating = False
' 検索対象のドライブ名をダイアログボックスで入力
TargetDrive = _
StrConv(InputBox("ドライブ名を入力してください", , "C"), vbNarrow)
If Len(TargetDrive) = 0 Then Exit Sub
' ファイルを検索
With Application.FileSearch
.NewSearch
.LookIn = TargetDrive & ":\"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks '---(1)
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
' タイトル行を作成
ActiveSheet.Cells(1, 1).Value = "File_Name"
ActiveSheet.Cells(1, 2).Value = "Size"
ActiveSheet.Cells(1, 3).Value = "Date"
For i = 1 To .FoundFiles.Count
Cells(i + 1, 1).Value = .FoundFiles(i)
Cells(i + 1, 2).Value = FileLen(.FoundFiles(i))
Cells(i + 1, 3).Value = FileDateTime(.FoundFiles(i))
Next i
ActiveSheet.Columns("A:C").AutoFit
MsgBox .FoundFiles.Count & " 個のファイルが見つかりました。"
Else
MsgBox "対象ファイルはありませんでした"
End If
End With
' 画面更新を再開
Application.ScreenUpdating = True
End Sub
検索対象のファイルの種類を指定するには、FileTypeプロパティを使用します。
Sampleでは「msoFileTypeExcelWorkbooks」を指定し、Excelファイルを検索しています。
Wordファイルを検索する場合は「msoFileTypeWordDocuments」を指定します。
FileTypeプロパティには、MsoFileType列挙体のメンバを指定してください。
また、ファイル名で検索する場合は、FileNameプロパティを使用します。
(1)のコードを次のようにすると、拡張子「.xls」のExcelファイルを検索します。
.Filename = "*.xls"