サブフォルダ内ファイルコピー

Sub prcPDFファイルをコピーする()
    ' 機能概要: フォルダAのサブフォルダ内のPDFをフォルダBにコピーする
    ' 留意点: サブフォルダのみ対象、フォルダA直下は対象外

    ' 変数宣言
    Dim fso As Object ' ファイル操作用オブジェクト
    Dim folSource As Object ' コピー元フォルダオブジェクト
    Dim folDestination As Object ' コピー先フォルダオブジェクト
    Dim folSubFolder As Object ' サブフォルダオブジェクト
    Dim fil As Object ' ファイルオブジェクト
    Dim strSourceFolderPath As String ' コピー元フォルダパス
    Dim strDestinationFolderPath As String ' コピー先フォルダパス

    ' フォルダパス設定
    strSourceFolderPath = "フォルダAのパス" ' コピー元フォルダパス
    strDestinationFolderPath = "フォルダBのパス" ' コピー先フォルダパス

    ' FileSystemObjectのインスタンス生成
    Set fso = New FileSystemObject

    ' コピー元とコピー先のフォルダオブジェクト取得
    Set folSource = fso.GetFolder(strSourceFolderPath)
    Set folDestination = fso.GetFolder(strDestinationFolderPath)

    ' サブフォルダ内のPDFファイルをコピー
    For Each folSubFolder In folSource.SubFolders
        For Each fil In folSubFolder.Files
            If LCase(fso.GetExtensionName(fil.Name)) = "pdf" Then
                fil.Copy fso.BuildPath(strDestinationFolderPath, fil.Name)
            End If
        Next fil
    Next folSubFolder

    ' オブジェクト解放
    Set fil = Nothing
    Set folSubFolder = Nothing
    Set folDestination = Nothing
    Set folSource = Nothing
    Set fso = Nothing
End Sub

コメント