89本目：2つのフォルダの統合

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：2つのフォルダの統合

#VBA100本ノック 89本目
フォルダ「A」とフォルダ「B」を統合してフォルダ「C」を作成する。
全サブフォルダの全ファイルを対象としてください。
同一フォルダに同一ファイル名となる場合は、より更新日時の新しいファイルを採用してください。
同一更新日時の場合はどちらでも良い。
※パスは任意

◇ 出題ページはこちら

ソースコード

メインモジュール

Option Explicit

Public FSO As New FileSystemObject
Private 第1フォルダ As Folder
Private 第2フォルダ As Folder
Private 統合フォルダ As Folder

' 100本ノック089：2つのフォルダの統合

' 実行プロシージャ
Sub 指定フォルダのフォルダ統合を実行する()
    
    ' 実行シートからパスを取得
    Dim Path第1フォルダ As String: Path第1フォルダ = WS実行シート.Range("C2")
    Dim Path第2フォルダ As String: Path第2フォルダ = WS実行シート.Range("C3")
    Dim Path統合フォルダ As String: Path統合フォルダ = WS実行シート.Range("C4")
    
    ' フォルダの存在チェック
    If FSO.FolderExists(Path第1フォルダ) = False Then: MsgBox "第1フォルダが存在しません。": Exit Sub
    If FSO.FolderExists(Path第2フォルダ) = False Then: MsgBox "第2フォルダが存在しません。": Exit Sub
    If FSO.FolderExists(Path統合フォルダ) = False Then: MsgBox "統合フォルダが存在しません。": Exit Sub
    
    ' 統合フォルダは空フォルダ指定に限定
    Dim 統合フォルダ As Folder: Set 統合フォルダ = FSO.GetFolder(Path統合フォルダ)
    If 統合フォルダ.SubFolders.Count > 0 Or 統合フォルダ.Files.Count > 0 Then
        MsgBox "統合先フォルダを空にしてから実行してください。"
        Exit Sub
    End If
    
    ' 統合の実行
    Call フォルダを統合する(Path第1フォルダ, Path第2フォルダ, Path統合フォルダ)
    
    MsgBox "フォルダの統合を完了しました。"
    
End Sub

' メインプロシージャ
Sub フォルダを統合する(Path第1フォルダ As String, Path第2フォルダ As String, Path統合フォルダ As String)
    
    Set 第1フォルダ = FSO.GetFolder(Path第1フォルダ)
    Set 第2フォルダ = FSO.GetFolder(Path第2フォルダ)
    Set 統合フォルダ = FSO.GetFolder(Path統合フォルダ)
    
    ' 統合先が空のフォルダでなければエラー
    If 統合フォルダ.SubFolders.Count > 0 Or 統合フォルダ.Files.Count > 0 Then
        Err.Raise 1000, , "統合先フォルダに既にファイル・フォルダが存在しています。"
    End If
    
    ' まずは第1フォルダの中身をすべてコピー
    第1フォルダ.Copy 統合フォルダ.Path
    
    ' 第2フォルダから統合フォルダへのコピー
    Call 統合フォルダにないかまたは更新日時が新しいファイルをコピーして下層フォルダへ再帰する(第2フォルダ)
    
End Sub

' 第2フォルダ内のフォルダ → 統合フォルダ
Private Sub 統合フォルダにないかまたは更新日時が新しいファイルをコピーして下層フォルダへ再帰する(第2内フォルダ As Folder)
    
    ' 対象フォルダ内のファイルをループ
    Dim コピー元ファイル As File
    For Each コピー元ファイル In 第2内フォルダ.Files
    
        ' コピー先のファイルパス(同じ相対位置で同名)を取得
        Dim pathコピー先ファイル As String
        pathコピー先ファイル = Replace(コピー元ファイル.Path, 第2フォルダ.Path, 統合フォルダ.Path)
    
        ' コピー先にファイルがなければそのままコピー
        If FSO.FileExists(pathコピー先ファイル) = False Then
            コピー元ファイル.Copy pathコピー先ファイル
            
        ' コピー先にファイルがあれば更新時間で判定してコピー
        Else
            Dim 比較対象ファイル As File
            Set 比較対象ファイル = FSO.GetFile(pathコピー先ファイル)
            
            If コピー元ファイル.DateLastModified > 比較対象ファイル.DateLastModified Then
                コピー元ファイル.Copy pathコピー先ファイル
            End If
            
        End If
        
    Next ' 対象フォルダ内のファイルをループ
    
    ' 対象フォルダ内のフォルダをループ
    Dim 子フォルダ As Folder
    For Each 子フォルダ In 第2内フォルダ.SubFolders
        
        ' コピー先のファイルパス(同じ相対位置で同名)を取得
        Dim pathコピー先フォルダ As String
        pathコピー先フォルダ = Replace(子フォルダ.Path, 第2フォルダ.Path, 統合フォルダ.Path)
    
        ' コピー先にフォルダがなければそのままコピー（再帰しない）
        If FSO.FolderExists(pathコピー先ファイル) = False Then
            子フォルダ.Copy pathコピー先フォルダ
            
        ' コピー先にフォルダがあれば再帰呼出
        Else
            Call 統合フォルダにないかまたは更新日時が新しいファイルをコピーして下層フォルダへ再帰する(子フォルダ)
            
        End If
        
    Next
    
End Sub

汎用関数モジュール

今回は汎用関数を使用していません。
※ 普段は冒頭のPublic変数が汎用関数モジュールにあります。

Public FSO As New FileSystemObject

解説

まずはプロシージャ分割の仕様ですが、
実行用のプロシージャと処理のメインプロシージャを分割しています。

メインプロシージャはフォルダパス3つを渡すと動くようになっており、
このように単純化しておくことでメインロジックをストレートに書けます。

統合フォルダをマクロで作ったり既存フォルダを指定したりといった、
実行フォルダの仕様はコロコロ変わりますのでそれを分けておくのも大事ですね。

肝心のメインロジックですが、せっかくのFileSystemObjectですので、
FileオブジェクトとFolderオブジェクトを積極的に活用しました。

FSO.CopyFileメソッドなどは極力使用せずに、
Fileオブジェクト.Copyを主に使って処理を書いています。

FileSystemObjectは本来
「File/Folderをオブジェクトとして扱えるようにする仕組み」
であり、うまく使うと文字列(パス)によるファイル操作から脱却できます。

この問題はFile/Folderオブジェクト操作の訓練にぴったりと思いましたので、
これらオブジェクトを使ったことがない方はこの機会に使ってみてください。

余談ですが、

Private Sub 統合フォルダにないかまたは更新日時が新しいファイルをコピーして下層フォルダへ再帰する(第2内フォルダ As Folder)

これがおそらくVBA100本ノック最長プロシージャ名でした。

こう書いても全然邪魔になりませんので、
コメントにこれを書くくらいならもうプロシージャ名にしてしまいましょう。