VBA100本ノック 89本目：2つのフォルダの統合

公開日：2021-02-16　最終更新日：2021-02-17

VBA100本ノック 89本目：2つのフォルダの統合

2つのフォルダをサブフォルダも含めて統合する問題です。
同一フォルダに同じファイル名が存在する場合は更新日時のより新しいファイルを採用します。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。

出題

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

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

全サブフォルダの探索は「66本目：全サブフォルダからファイルを探す」でやりました。
フォルダ、ファイル、再帰、これらの復習問題です。
最初のフォルダ「A」はフォルダごとコピーしています。
フォルダ「B」コピー時にファイルが既に存在していた場合に更新日付を確認してからコピーしています。


  
    
      Sub VBA100_89_01()

　　Dim sPathA As String: sPathA = ThisWorkbook.Path & "\A"

　　Dim sPathB As String: sPathB = ThisWorkbook.Path & "\B"

　　Dim sPathC As String: sPathC = ThisWorkbook.Path & "\C"

　　

　　Dim fso As New FileSystemObject

　　If fso.FolderExists(sPathC) Then Call fso.DeleteFolder(sPathC, True)

　　

　　Call fso.CopyFolder(sPathA, sPathC, True)

　　Call copyFile(fso, fso.GetFolder(sPathB), sPathB, sPathC)

　　

　　Set fso = Nothing

End Sub


Sub copyFile(ByVal fso As FileSystemObject, ByVal fromFolder As Folder, ByRef fromRoot As String, ByRef toRoot As String)

　　Dim sToPath As String

　　sToPath = repFolderName(fromFolder.Path, fromRoot, toRoot)

　　If Not fso.FolderExists(sToPath) Then

　　　　Call fso.CopyFolder(fromFolder, sToPath, True)

　　　　Exit Sub

　　End If

　　

　　Dim oFile As File, sFilePath As String

　　For Each oFile In fromFolder.Files

　　　　sFilePath = repFolderName(oFile.Path, fromRoot, toRoot)

　　　　If fso.FileExists(sFilePath) Then

　　　　　　If oFile.DateLastModified > fso.GetFile(sFilePath).DateLastModified Then

　　　　　　　　Call fso.copyFile(oFile.Path, sFilePath, True)

　　　　　　End If

　　　　Else

　　　　　　Call fso.copyFile(oFile.Path, sFilePath, True)

　　　　End If

　　Next

　　

　　Dim oFolder As Folder

　　For Each oFolder In fromFolder.SubFolders

　　　　Call copyFile(fso, oFolder, fromRoot, toRoot)

　　Next

End Sub


Function repFolderName(ByVal sFromFolder As String, ByRef sFromFolderR As String, ByRef sRootToR As String) As String

　　repFolderName = sRootToR & Mid(sFromFolder, Len(sFromFolderR) + 1)

End Function

今回は復習問題でしたので、まったく別の方法を紹介しておきます。
この処理内容は、DOSコマンドのxcopyで/d指定した場合と同じです。
そこで、WshShellでxcopyを実行するサンプルVBAを記事補足に掲載しました。

補足

DOSコマンドで、
xcopy /d /i /e /y "元フォルダ" "先フォルダ"
これを「A」「B」それぞれについて行った結果と同じになります。

DOSコマンドを実行する方法として、WshShell（Wscript.Shell）を使います。
ExecまたはRunでコマンドを実行できます。
以下では2通りを紹介しておきます。

以下では参照設定をしています。
「Windows Script Host Object Model」
Dim wsh As New IWshRuntimeLibrary.WshShell
Dim wExec As WshExec

実行時バインディングの場合は、
Dim wsh As Object: Set wsh = CreateObject("Wscript.Shell")
Dim wExec As Object

WshShell（Wscript.Shell）のExec


  
    
      Sub VBA100_88_02()

      　　Dim sPathA As String: sPathA = ThisWorkbook.Path & "\A"

      　　Dim sPathB As String: sPathB = ThisWorkbook.Path & "\B"

      　　Dim sPathC As String: sPathC = ThisWorkbook.Path & "\C"

      　　

      　　Dim fso As New FileSystemObject

      　　If fso.FolderExists(sPathC) Then Call fso.DeleteFolder(sPathC, True)

      　　Set fso = Nothing

      　　

      　　Dim sLogFile As String

      　　sLogFile = ThisWorkbook.Path & "\VBA100_88_" & Format(Now(), "yyyymmddhhmmss") & ".log"

      　　

      　　Call execXcopy(sPathA, sPathC, sLogFile)

      　　Call execXcopy(sPathB, sPathC, sLogFile)

      　　

      　　ThisWorkbook.FollowHyperlink sLogFile

      End Sub


      Sub execXcopy(ByVal fromPath As String, ByVal toPath As String, ByVal aLogFile As String)

      　　Dim wsh As New IWshRuntimeLibrary.WshShell

      　　Dim wExec As WshExec

      　　Dim sCmd As String

      　　sCmd = "xcopy /d /i /e /y """ & fromPath & """ """ & toPath & "\"" >> """ & aLogFile & """"

      　　Set wExec = wsh.Exec("%ComSpec% /c " & sCmd)

      　　Do While wExec.Status = 0

      　　　　DoEvents

      　　Loop

      　　Set wsh = Nothing

      End Sub

DOS窓が一瞬表示されます。
戻り値のオブジェクトを使う事で、標準出力も取得できます。
詳細は以下のMS公式ページを参照してください。
WshScriptExec オブジェクト
StdOut プロパティ (WshScriptExec)

WshShell（Wscript.Shell）のRun


  
    
      Sub VBA100_88_03()

　　Dim sPathA As String: sPathA = ThisWorkbook.Path & "\A 1"

　　Dim sPathB As String: sPathB = ThisWorkbook.Path & "\B 2"

　　Dim sPathC As String: sPathC = ThisWorkbook.Path & "\C 3"

　　

　　Dim fso As New FileSystemObject

　　If fso.FolderExists(sPathC) Then Call fso.DeleteFolder(sPathC, True)

　　Set fso = Nothing

　　

　　Dim sLogFile As String

　　sLogFile = ThisWorkbook.Path & "\VBA100_88_" & Format(Now(), "yyyymmddhhmmss") & ".log"

　　

      　　Call runXcopy(sPathA, sPathC, sLogFile)

　　Call runXcopy(sPathB, sPathC, sLogFile)

　　

　　ThisWorkbook.FollowHyperlink sLogFile

End Sub


      Sub runXcopy(ByVal fromPath As String, ByVal toPath As String, ByVal aLogFile As String)

      　　Dim wsh As New IWshRuntimeLibrary.WshShell

　　Dim sCmd As String

　　sCmd = "xcopy /d /i /e /y """ & fromPath & """ """ & toPath & "\"" >> """ & aLogFile & """"

      　　Call wsh.Run("%ComSpec% /c " & sCmd, 0, True)

　　Set wsh = Nothing

End Sub

WshShellオブジェクト.Run(strCommand, [intWindowStyle], [bWaitOnReturn])

object

WshShell オブジェクトです。

strCommand

実行するコマンドラインを示す文字列値です。
この引数には、実行可能ファイルに渡すべきパラメータをすべて含める必要があります。

intWindowStyle

省略可能です。
プログラムのウィンドウの外観を示す整数値です。

値	内容
0	ウィンドウを非表示にし、別のウィンドウをアクティブにします。
1	ウィンドウをアクティブにして表示します。ウィンドウが最小化または最大化されている場合は、元のサイズと位置に戻ります。アプリケーションでウィンドウを最初に表示するときには、このフラグを指定してください。
2	ウィンドウをアクティブにし、最小化ウィンドウとして表示します。
3	ウィンドウをアクティブにし、最大化ウィンドウとして表示します。
4	ウィンドウを最新のサイズと位置で表示します。アクティブなウィンドウは切り替わりません。
5	ウィンドウをアクティブにし、現在のサイズと位置で表示します。
6	指定したウィンドウを最小化し、Z オーダー上で次に上位となるウィンドウをアクティブにします。
7	ウィンドウを最小化ウィンドウとして表示します。アクティブなウィンドウは切り替わりません。
8	ウィンドウを現在の状態で表示します。アクティブなウィンドウは切り替わりません。
9	ウィンドウをアクティブにして表示します。ウィンドウが最小化または最大化されている場合は、元のサイズと位置に戻ります。アプリケーションで最小化ウィンドウを復元するときには、このフラグを指定してください。
10	アプリケーションを起動したプログラムの状態に基づいて、表示状態を設定します。

bWaitOnReturn

省略可能です。
スクリプト内の次のステートメントに進まずにプログラムの実行が終了するまでスクリプトを待機させるかどうかを示すブール値です。
TRUE を指定すると、プログラムの実行が終了するまでスクリプトの実行は中断され、Runメソッドはアプリケーションから返される任意のエラーコードを返します。
bWaitOnReturnにFALSE を指定すると、プログラムが開始するとRunメソッドは即座に復帰して自動的に 0 を返します。

詳細は以下のMS公式ページを参照してください。
WshShell オブジェクトのプロパティとメソッド
Run メソッド

サイト内関連ページ

57本目：ファイルの更新日時

・出題・頂いた回答・解説・補足・サイト内関連ページ

66本目：全サブフォルダからファイルを探す

・出題・頂いた回答・解説・補足・サイト内関連ページ

特殊フォルダの取得（WScript.Shell,SpecialFolders）

・WScript.Shell ・SpecialFolders プロパティ・WshShellのSpecialFoldersのマクロVBA使用例

VBAでファイルを既定のアプリで開く方法

・実行テストメイン・Shell関数・batファイル（コマンドプロンプト）・WScript.Shell ・Shell.Application ・FollowHyperlink ・最後に

同じテーマ「VBA100本ノック」の記事

86本目：全シートの総当たり表を作成
 87本目：数式のシート間の依存関係
 88本目：クロスABC分析作成
89本目：2つのフォルダの統合
90本目：セルに重なっている画像の削除
 91本目：時間計算（残業時間の月間合計）
92本目：セルの色を16進で返す関数
 93本目：複数ブックを連結して再分割
 94本目：表範囲からHTMLのtableタグを作成
 95本目：図形のテキストを検索するフォーム作成
 96本目：Accessデータを取得（マスタ結合&抽出）

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
89本目：2つのフォルダの統合

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 89本目：2つのフォルダの統合