no title


Option Explicit

Sub test()

Call FileSearch(ThisWorkbook.Path & "\検索対象")
End Sub


Sub FileSearch(Path As String)
'変数を宣言
Dim FSO As Object, Folder As Variant, File As Variant, CopytoFolder As String
Dim i As Long, Target As String, Target2 As String

'初期値を設定
Set FSO = CreateObject("Scripting.FileSystemObject")
CopytoFolder = ThisWorkbook.Path & "\コピー先" 'コピー先フォルダ
Target = "*.xls*"
Target2 = "*.pdf"

'サブフォルダ検索のため再帰呼び出し
For Each Folder In FSO.GetFolder(Path).SubFolders
Call FileSearch(Folder.Path)
Next Folder

'見つかった全てのファイルに対し
For Each File In FSO.GetFolder(Path).Files
'"*.xls*"か "*.pdf"に部分一致するなら
If File.Name Like Target Or File.Name Like Target2 Then
'フォルダBへコピー
FSO.copyFile File.Path, CopytoFolder & "\複" & File.Name
End If
'次のファイルの処理へ進む
Next File

End Sub
お知らせ
実務でも趣味でも役に立つ多機能Webツールサイト【無限ツールズ】で、日常をちょっと便利にしちゃいましょう!
無限ツールズ

 
writening