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

VBAを100本の練習問題で鍛えます
最終更新日:2021-02-17

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


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


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

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


出題

出題ツイートへのリンク

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


頂いた回答

解説

全サブフォルダの探索は「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本目:ファイルの更新日時
バックアップファイルの各更新日付の最終時刻のファイルだけを残し、他を削除する問題です。ツイッター連動企画です。ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。VBAテスト用のサンプルデータはご自身でご用意ください。
66本目:全サブフォルダからファイルを探す
ブック自身のあるフォルダ以下の全サブフォルダを検索する問題です。ツイッター連動企画です。ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。VBAテスト用のサンプルデータはご自身でご用意ください。
特殊フォルダの取得(WScript.Shell,SpecialFolders)
デスクトップのフォルダ、スタートメニューのフォルダ、個人用ドキュメントのフォルダなど、Windowsの特殊フォルダを取得するには、ネイティブのWindowsシェルへのアクセスを提供するWScript.ShellのSpecialFoldersプロパティを使用します。CreateObject関数で作成したWscript…
VBAでファイルを既定のアプリで開く方法
Excelマクロで、エクセル以外のファイルを既定のアプリケーションで開く場合の方法について何通りか解説します、VBAでファイルを単純に開くだけの場合についてになります。ファイルを開いた後に、そのファイルに対して何らかの操作をしたい場合は、対応するアプリケーション毎に個別の対応が必要になりますが、Windowsで開け…




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

84本目:ブックの自動バックアップ
85本目:請求日から入金予定日を算出
86本目:全シートの総当たり表を作成
87本目:数式のシート間の依存関係
88本目:クロスABC分析作成
89本目:2つのフォルダの統合
90本目:セルに重なっている画像の削除
91本目:時間計算(残業時間の月間合計)
92本目:セルの色を16進で返す関数
93本目:複数ブックを連結して再分割
94本目:表範囲からHTMLのtableタグを作成


新着記事NEW ・・・新着記事一覧を見る

キーボード操作だけで非表示列を表示|エクセル雑感(2021-05-11)
変数を考えることはロジックを考える事|エクセル雑感(2021-04-11)
RangeオブジェクトのFor EachとAreasについて|VBA技術解説(2021-04-08)
PropertyのSetはLetでも良い|VBA技術解説(2021-03-31)
エクセル麻雀ミニゲーム|VBAサンプル集(2021-03-09)
VBA100本ノック 100本目:WEBから100本ノックのリストを取得|VBA練習問題(2021-03-03)
VBA100本ノック 魔球編:2桁の最小公倍数|VBA練習問題(2021-02-02)
Select Caseでの短絡評価(ショートサーキット)の使い方|VBA技術解説(2021-01-03)
VBA100本ノック 迷宮編:巡回セル問題|VBA練習問題(2020-12-31)
VBA100本ノック 魔球編:閉領域の塗り潰し|VBA練習問題(2020-12-16)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.Excelショートカットキー一覧|Excelリファレンス
3.RangeとCellsの使い方|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.繰り返し処理(For Next)|VBA入門
7.ひらがな⇔カタカナの変換|エクセル基本操作
8.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
9.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
10.セルに文字を入れるとは(Range,Value)|VBA入門




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


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



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