以下のマクロは、入力されたドライブ全体から全てのExcelファイルを
検索するマクロです。また、見つかったファイルのパスを含むファイル名
とファイルサイズ及び、更新日付をシート上に貼り付けます。
Sub File_Search()
Dim i As Long
Dim myFound As String
Dim sDrv As String
' 画面更新をとめます
Application.ScreenUpdating = False
' 検索対象となるドライブ名を入力させます
sDrv = StrConv(InputBox("ドライブ名を入力してください", _
"ドライブ名設定", "C"), vbNarrow) & ":\"
DefaultSheetNum% = Application.SheetsInNewWorkbook
' タイトル行を作成します
ActiveSheet.Cells(1, 1).Value = "File_Name"
ActiveSheet.Cells(1, 2).Value = "Size"
ActiveSheet.Cells(1, 3).Value = "Date"
' ファイル検索を開始します
With Application.FileSearch
.NewSearch
.LookIn = sDrv
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
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
|