VBA サブフォルダ内ファイルの取得(FSO)




エクセル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)を選択

16,17行目
MkDir dir1 & "after"
dir2 = dir1 & "after"

→親フォルダ内に"after"というコピー先のフォルダ(dir2)を作成


参照・類似ページ
Application.FileDialog(msoFileDialogFolderPicker)
Dir
MkDir
ラベル: ,