エクセル マクロ VBA ファイル検索コピー

お世話になります。
エクセルのマクロでファイルを検索しコピーしたくいろいろ試しているのですが、うまくいきません。
やりたいこととしては、

C:\Users\〇〇\Desktop\□□
|-2018年1月-AAA.xlsx
|　　　　　 555-BBB.xlsx　←このファイルをコピーしたい
|
|-2018年2月-CCC.xlsx　
| DDD.xlsx
|
|-2018年3月-333-EEE.xlsx
| 111-FFF.xlsx 　←このファイルをコピーしたい
|
|- :
|-　　:　
|-　　:　　
|-2018年12月-


検索コピー.xlsxファイルのA4セルから下にファイル名（一部の場合あり）名前を記入し、
マクロを実行すると
C:\Users\☆☆☆\Desktop\☆☆☆ というフォルダに、検索で見つかったファイルをコピーしたいです。

例、
検索コピー.xlsxファイルのA4セルに「BBB」
検索コピー.xlsxファイルのA5セルに「FFF」　検索ファイルは増える場合があります。
マクロ実行
C:\Users\☆☆☆\Desktop\☆☆☆　フォルダに
555-BBB.xlsx
111-FFF.xlsx ファイルがコピーされる。


※検索するファイル名の一部は、BBBやFFFです。
※検索コピー.xlsxファイルにマクロを組みたいです。
※コピー先のフォルダは、もともとありますが、マクロ実行と共に新規にできてもかまいません。
※検索元のファイルは、コピー後消しません。

単一のファイルコピーや、フォルダ全部のコピーは何とか出来たのですが、階層をまたぐ場合やファイル名の一部を検索するのがうまくいきません、、、
分かりにくい説明で申し訳ございませんが、何卒よろしくお願いします。

No.2 回答者： fujillin 回答日時： 2018/12/18 14:18

こんにちは

＞ファイル名の一部を検索するのがうまくいきません、、、
とのことですので、その部分に関しての一例を。

検索のルールが今一つわかりませんが、ひとまず以下の様に仮定しました。
A列のセルに「BBB」とある場合、拡張子の「.xlsx」は固定と考えて、
ファイル名の後ろ8文字が「BBB.xlsx」のものを検索することにします。
「hogeBBB.xlsx」や「fugaBBB.xlsx」は該当しますが、「piyoBB.xlsx」や「hogeBBB.xlsm」は該当しないものとしています。

以下のサンプルは、A列のA4セル以降に記入されている文字列に相当するファイルをデスクトップフォルダ以下から検索し、B列に該当ファイルのパスを書き出すサンプルです。
該当するものが複数存在する場合は、ひとまず全て書き出すようにしてあります。

Sub SampleY3()
　Dim baseP As String, fName As String, r As Long
　baseP = CreateObject("WScript.Shell").SpecialFolders("Desktop")
　For r = 4 To Cells(Rows.Count, 1).End(xlUp).Row
　　fName = Cells(r, 1).Text
　　If fName <> "" Then
　　　Call fileSearch(baseP, fName & ".xlsx")
　　End If
　Next r
End Sub


Sub fileSearch(path As String, tf As String)
　Dim FSO As Object, folder, file
　Dim rw As Long, n As Integer
　Set FSO = CreateObject("Scripting.FileSystemObject")
　n = Len(tf)

　For Each file In FSO.getfolder(path).Files
　　If Right(file.Name, n) = tf Then

' 該当ファイルのパスをシート（B列）に書き出す
　　　rw = Application.Max(Cells(Rows.Count, 2).End(xlUp).Row, 4)
　　　If Cells(rw, 2) <> "" Then rw = rw + 1
　　　Cells(rw, 2).Value = file.path

　　End If
　Next file
　For Each folder In FSO.getfolder(path).SubFolders
　　Call fileSearch(folder.path, tf)
　Next folder
End Sub

もしも、こんな感じの抽出で良いのであれば、シートに書き出す代わりにファイルをコピーすれば良いことになりますが、同名のファイルが複数抽出されていたり、同名のファイルが既に存在していたりする可能性がありますので、コピーの際には事前にチェックして名前を変えたり、コピー処理をスキップするなどの対策が必要なように思えます。

この回答へのお礼

お世話になります。

ご回答ありがとうございます。
試してみたところ、一部ファイル名を含むファイルのパスを書き出すことができました。
今後勉強しいろいろ試していこうと思います。
誠にありがとうございました！

お礼日時：2018/12/18 14:54

No.1 回答者： gisahan 回答日時： 2018/12/18 09:45

ファイル自体全体を単独でコピーは、ホルダーを移動しても支障はないものと考えますが、（新しく開いたときに「マクロを有効にする」クリック操作は必要）

ファイルの一部やセルの中に移しこむということは無理だと考えます。
＝コピーされ内容が変わったファイルには新しいマクロの定義の挿入が必要です。

この回答へのお礼

早々のご回答誠にありがとうございます。
こちらの説明不足のようです、申し訳ございません。


ファイル自体全体を単独でコピーは、ホルダーを移動しても支障はないものと考えますが、（新しく開いたときに「マクロを有効にする」クリック操作は必要）
⇒コピーしたいファイル、555-BBB.xlsxや111-FFF.xlsxにはマクロは組んでおりません。
マクロを組むのは検索コピー.xlsxファイルのみ（場所はデスクトップです。）なのですが、その場合でも難しいでしょうか？


ファイルの一部やセルの中に移しこむということは無理だと考えます。
＝コピーされ内容が変わったファイルには新しいマクロの定義の挿入が必要です。
⇒コピーするファイルの内容は、変更せず、ファイル名もそのままでコピーしたいです。

うまく説明ができているかわかりませんが、よろしくお願いします。

お礼日時：2018/12/18 10:04