フォルダの差分同期をExcel（VBA）で行う

　VBAの勉強エントリです。
　自分がデータ分析とかをやる場面ではべつにVBAを使う必要はなく、RやPythonでやればいいのですが、会社の仕事で他の人たちと共同作業する上では、Excelとかのマクロが組めると便利だろうなと思うことが多いです。
　しかしほっといたらいつまでたっても勉強しないので、「とりあえず使いこなせるレベルにはならなくていいから、VBAで何かやるときの作業イメージをつかんで、いざ必要になったときの心理的ハードルを下げておきたい」と思い、ちょっといじってみています。
　何かVBAでできそうなタスクがあったときに、「ググりながら時間かければ俺でも何とかできるかも」という前向きなモチベーションを持てるようにしておくのが目的です。
　
　

フォルダの同期

　VBAで２つのフォルダの中身を比較して、差分の同期をする方法を検索したら、robocopyというWindowsのコマンドをVBAから起動する方法が載っていた。
【robocopyコマンドでフォルダーをバックアップ／同期する】【エクセル2013,VBA】 - DuKiccoの雑記
Office TANAKA - Excel VBA Tips[MS-DOSコマンドの標準出力を取得する]
Tech TIPS：Windowsのrobocopyコマンドでフォルダーをバックアップ／同期させる - ＠IT

　VBAの練習台にと思って、適当にボタンを配置して、同期元と同期先のフォルダをそれぞれ選択し、同期するマクロを作りました。
　練習台なのでかなり適当です。
　「同期元を選択」ボタンを押すとダイアログが開くので、フォルダを選択すると、E4セルに書きこまれます。「同期先を選択」はE9セルに書き込みます。
　それで「同期！」ボタンを押すと差分同期が始まり、B15以下のセルに処理のログが書きこまれます。「結果の削除」ボタンを押すとログが消えます。

　
　

同期元フォルダを選択するボタン用のコード

　前回のエントリでも使った「msoFileDialogFolderPicker」ってのを使い、GUIで対話的にフォルダを選択して、選択したフォルダのパスを所定のセルに記入するようにします。

Sub GetSrcPath()

    Dim strSrcPath As String                           ' フォルダのパスを格納する変数
    Dim dlgFolder As Office.FileDialog                 ' ダイアログを受け取る変数
    Set dlgFolder = Application.FileDialog(msoFileDialogFolderPicker)
    
    If dlgFolder.Show = False Then                     ' キャンセルが押されたら抜ける
        Exit Sub
    
    Else
        strSrcPath = dlgFolder.SelectedItems(1) & "\"  ' 選択されたフォルダのパスを受け取る
        Range("E4").Value = strSrcPath                 ' セルに書き込む
    End If
    
End Sub

同期先フォルダを選択するボタン用のコード

上とほぼ同じです。

Sub GetDstPath()

    Dim strDstPath As String                           ' フォルダのパスを格納する変数
    Dim dlgFolder As Office.FileDialog                 ' ダイアログを受け取る変数
    Set dlgFolder = Application.FileDialog(msoFileDialogFolderPicker)
    
    If dlgFolder.Show = False Then                     ' キャンセルが押されたら抜ける
        Exit Sub
    Else
        strDstPath = dlgFolder.SelectedItems(1) & "\"  ' 選択されたフォルダのパスを受け取る
        Range("E9").Value = strDstPath                 ' セルに書き込む
    End If
    
End Sub

フォルダを同期するボタン用のコード。

　前提として、VBEの参照設定で「Windows Script Host Object Library」への参照をONにしておく必要があります。
　WScript.Shellは、Execメソッドに対して文字列でWindowsのコマンドを与えてやればそれが実行されるようで、かなり便利ですね。
　なおrobocopyは、MacやLinuxのrsyncっていうコマンドに似ていて、「robocopy src dst /option」という書き方で、srcからdstへのコピーを行ってくれるようです。/mirというオプションは、フォルダの中がばっちり同じ内容になるやつ。
　コマンドの実行に時間がかかるので、VBA側では、処理が終了するまで待つためのループを書くらしいのですが、ふつうに書くとOSのコマンドに処理を投げたあとはほったらかしでVBA内の次の処理に行ってしまうということなんでしょうか。
　処理のログは、１つのセルに書くと見づらいので、改行コードで分割して配列にし、ループで１行１行書いていくようにしました。

Sub RunRoboCopy()

    Dim WSH    As IWshRuntimeLibrary.WshShell
    Dim wExec
    Dim sCmd   As String
    Dim Result As String
    Dim Src    As String
    Dim Dst    As String
    Dim Lines  As Variant
    Dim i      As Integer

    Src = Range("E4").Value '同期元フォルダのパス
    Dst = Range("E9").Value '同期先フォルダのパス

    Set WSH = CreateObject("WScript.Shell")

    sCmd = "robocopy " & Src & " " & Dst & " /mir"  '/mirオプションを付けたrobocopyコマンド
    Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)    'コマンドの実行

    Do While wExec.Status = 0                       '処理が終了するのを待つループ
        DoEvents
    Loop

    Result = wExec.StdOut.ReadAll     ' 結果の取得
    Lines = Split(Result, vbCrLf)     ' 改行コードで分割して配列を得る
    For i = 0 To UBound(Lines)        ' １行ごとに出力するループ
        Cells(i + 15, 2) = Lines(i)
    Next i

    Set wExec = Nothing
    Set WSH = Nothing

End Sub

結果を削除するボタン用のコード

下端まで指定する方法が良く分からなかったので1万行目まで消すようにした。

Sub ClearResult()
    Range(Cells(15, 2), Cells(10000, 2)).Clear
End Sub