エクセルVBAでフォルダ内フォルダ(サブフォルダ)のファイルを取得して一括コピーする例です。
・FileSystemObject(FSO)
・Dir
などを使用します。
Option Explicit Sub imd() '※参照設定でMicrosoft Scripting Runtimeにチェック Dim FSO As FileSystemObject ' FSO Set FSO = New FileSystemObject '元の親フォルダ=dir1 Dim dir1 As String 'ダイアログボックスから元親フォルダ選択 Application.FileDialog(msoFileDialogFolderPicker).Show dir1 = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\" 'コピー先のFolder=dir2 Dim dir2 As String MkDir dir1 & "after" dir2 = dir1 & "after" 'コピー対象ファイル=tg Dim tg As String '個々のサブフォルダ Dim subF As String subF = Dir(dir1 & "\", vbDirectory) Do While subF <> "" If subF <> "." And subF <> ".." Then ' なんか変なのが返ってくるので無視する '例としてサブフォルダ内のエクセルファイルを対象 tg = dir1 & subF & "\*.xls" ' FSOによるファイルコピー FSO.copyFile tg, dir2 End If subF = Dir() Loop Set FSO = Nothing End Sub
Application.FileDialogでダイアログボックスからフォルダを取得しているのでそのままでも使用出来ると思います。
このまま実行する場合は参照設定で[Microsoft Scripting Runtime]にチェックを入れてください。
11,12行目
Application.FileDialog(msoFileDialogFolderPicker).Show
dir1 = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
dir1 = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
→取得対象元の親フォルダ(dir1)を選択
16,17行目
MkDir dir1 & "after"
dir2 = dir1 & "after"
dir2 = dir1 & "after"
→親フォルダ内に"after"というコピー先のフォルダ(dir2)を作成
参照・類似ページ
Application.FileDialog(msoFileDialogFolderPicker)Dir
MkDir