yuu********

2022/1/22 20:30

11回答

【フォルダ内のファイルの吸出し（WINDOWS10）】 複数のフォルダがあり、フォルダによっては、さらに下層にもフォルダがあり、

【フォルダ内のファイルの吸出し（WINDOWS10）】 複数のフォルダがあり、フォルダによっては、さらに下層にもフォルダがあり、 複数のファイル（エクセル（xlsx、xlsm)、PDF）が収納されています。 そこで 選択した複数のフォルダ内のファイル （そのフォルダに収納されれている下層のフォルダに収納されているファイルを含む）を、指定したフォルダにコピーしたいのです。 できれば、 ①そのコピーしたファイルは（元のファイルと区別ができるように） ファイル名末尾に「複」とか、何かわかる文字を付けたいです （元のファイルと同じ名前のファイルがPC内に複数存在するのがイヤなので）。 ➁フォルダ内に含まれるファイルの種類を選別して吸出したいです （エクセルとPDF だけでよく、他の種類のファイルは必要ないです。 エクセルも「xlsx」「xlsm」の区別をしない、あるいは「xlsx」だけでも良いです。） よろしくお願いいたします。

Excel・26閲覧・xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0
薄い水色の点

2022/1/22 22:46

コードを記述するエクセルファイルと同じフォルダに 「検索対象」「コピー先」という２つのフォルダを用意し、 マクロ testを実行してください。 コードが文字化けしていたら以下のリンク先のコードをコピーしてください。テキスト共有サービスです。 https://writening.net/page?mhMiFz 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 'フォルダＢへコピー FSO.copyFile File.Path, CopytoFolder & "\複" & File.Name End If '次のファイルの処理へ進む Next File End Sub