発熱するマイナー魂

隠れた名作の発掘が生きがい。サブカル作品の感想とIT技術メモ中心のブログです。

【VBA】特定のファイルを除外して、フォルダ配下のファイルをコピーする


スポンサードリンク

フォルダA配下のファイルとフォルダをまるごとフォルダBにコピーするときに、特定のファイルはコピーしたくない時もあったりします。VBAでフォルダAにある特定のファイルを無視してフォルダBにコピーする方法をメモしました。

Option Explicit

Sub Copy()
    ' (A) コピー元フォルダ
    Dim inputRootDir As String
    inputRootDir = "C:\work\Input"

    ' (A) コピー先フォルダ
    Dim outputRootDir As String
    outputRootDir = "C:\work\Output"

    ' (A) ファイル名の除外パターン
    Dim reExcludeFile As RegExp
    Set reExcludeFile = New RegExp
    reExcludeFile.Pattern = "b.txt$"    

    ' (B) コピー元ファイルリストを取得
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
   
    Dim fileList As Collection
    Set fileList = New Collection
    Dim folderList As Collection
    Set folderList = New Collection
   
    ' (B) ファイルとフォルダのリストを取得
    Call GetFileAndFolderNameList(fso.GetFolder(inputRootDir), fileList, folderList)
   
    ' (C) ファイルコピー実行
    Dim i As Integer
    For i = 1 To fileList.Count
        ' (C) ファイル名の除外パターンに一致しない場合
        If reExcludeFile.Test(fileList(i)) = False Then
            ' (C) コピー先のファイル名
            Dim outputFilePath As String
            outputFilePath = outputRootDir + Replace(fileList(i), inputRootDir, "")
           
            ' (C) コピー先のフォルダ作成
            Call CreateFolder(fso.GetParentFolderName(outputFilePath))
           
            ' (C) ファイルコピー
            Call FileCopy(fileList(i), outputFilePath)
           
        End If
    Next i
   
    Set fileList = Nothing
    Set folderList = Nothing
    Set reExcludeFile = Nothing
    Set fso = Nothing
   
End Sub

''' 指定されたフォルダを再帰的に作成する
Private Sub CreateFolder(ByVal targetFolderPath As String)
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
   
    Dim parentFolder As String
    parentFolder = fso.GetParentFolderName(targetFolderPath)
    If Not fso.FolderExists(parentFolder) Then
        Call CreateFolder(parentFolder)
    End If
   
    If fso.FolderExists(targetFolderPath) = False Then
        fso.CreateFolder (targetFolderPath)
    End If
   
    Set fso = Nothing
End Sub


実行には「Microsoft Scripting Runtime」と「Microsoft VBScript Regular Expressions 5.5」が必要なので、VBAのTools->Referencesよりそれらのチェックをつけておきます。


(A) コピー元、コピー先、除外ファイルのパターンを設定します。


(B) コピー元のファイル一覧を取得します。詳細は【VBA】ファイルとフォルダのリストを再帰的に取得するに書いています。


(C) ファイルの除外パターンに一致しないファイルをコピーします。まず、コピー先の子フォルダを再帰的に作成し、その子フォルダにファイルをコピーします。


例えば次のフォルダ・ファイル構成だったとき、

C:\work\Input\a.txt
C:\work\Input\b.txt
C:\work\Input\c.txt
C:\work\Input\hoge\a.txt
C:\work\Input\hoge\b.txt
C:\work\Input\hoge\c.txt
C:\work\Input\hoge\moge\a.txt
C:\work\Input\hoge\moge\b.txt
C:\work\Input\piyo\a.txt


下記のようにファイルがコピーされました。

C:\work\Output\a.txt
C:\work\Output\c.txt
C:\work\Output\hoge\a.txt
C:\work\Output\hoge\c.txt
C:\work\Output\hoge\moge\a.txt
C:\work\Output\piyo\a.txt