##仕様
指定フォルダ内でキーワード検索をして
該当したファイル名一覧をExcelシート上に記入する
・ 動作前に記入セル内をクリアする
・ 以下の時はポップアップ表示
- 終了時に該当件数をポップアップ表示
- 検索キーワード未記入の場合
##ユーザーから見た画面
①で検索ワードを記入
②「検索する」ボタンを押下
③検索結果のファイル名一覧が表示される
Cドライブにtestファイルを作りました。
結果画面
検索キーワード未記入の場合
Sub ファイル一覧の取得()
Dim format As String '拡張子'
Dim cnt As Long 'カウント'
Dim MaxRow As Long '最終行'
Const Path As String = "C:\test\" '固定ディレクトリパス'
buf = Range("B4").Value '検索ワード'
format = Dir(Path & "*" & buf & "*.xlsx") '検索するExcelファイル名'
cnt = 6 '検索結果 ファイル名記入セルの行番号-1'
Range("B7", Range("B7").SpecialCells(xlLastCell)).ClearContents '検索結果セル内の値をクリアする'
If buf = "" Then
msg = "検索ワードを入力してください。"
MsgBox msg, Buttons:=vbInformation
Else
Do While format <> "" '空文字になるまで繰り返す
cnt = cnt + 1
Cells(cnt, 2) = format
format = Dir() 'フォルダに存在するすべてのファイル名を取得する
Loop
Debug.Print cnt
MaxRow = Cells(Rows.Count, 2).End(xlUp).row 'B列=2'
FileNum = MaxRow - 6 '検索結果数'
If FileNum < 0 Then
FileNum = 0
End If
msg = "検索結果 " & FileNum & " 件"
MsgBox msg, Buttons:=vbInformation
End If
End Sub