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.ShellのSpecialFolder…
VBAでファイルを既定のアプリで開く方法
Excelマクロで、エクセル以外のファイルを既定のアプリケーションで開く場合の方法について何通りか解説します、VBAでファイルを単純に開くだけの場合についてになります。ファイルを開いた後に、そのファイルに対して何らかの操作をしたい場合は、対応するアプリケーション毎に個別の対応が必要になりますが、Windowsで開けるファイルであり、




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

83本目:請求書を作成してPDF出力
84本目:ブックの自動バックアップ
85本目:請求日から入金予定日を算出
86本目:全シートの総当たり表を作成
87本目:数式のシート間の依存関係
88本目:クロスABC分析作成
89本目:2つのフォルダの統合
90本目:セルに重なっている画像の削除
魔球編:組み合わせ問題
魔球編:閉領域の塗り潰し
迷宮編:巡回セル問題


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

VBA100本ノック 90本目:セルに重なっている画像の削除|VBA練習問題(2月16日)
VBA100本ノック 89本目:2つのフォルダの統合|VBA練習問題(2月16日)
VBA100本ノック 88本目:クロスABC分析作成|VBA練習問題(2月15日)
VBA100本ノック 87本目:数式のシート間の依存関係|VBA練習問題(2月13日)
VBA100本ノック 86本目:全シートの総当たり表を作成|VBA練習問題(2月12日)
VBA100本ノック 85本目:請求日から入金予定日を算出|VBA練習問題(2月10日)
VBA100本ノック 84本目:ブックの自動バックアップ|VBA練習問題(2月9日)
VBA100本ノック 83本目:請求書を作成してPDF出力|VBA練習問題(2月8日)
VBA100本ノック 参加者様ご紹介|VBA練習問題(2月5日)
VBA100本ノック 82本目:ブックのドキュメントプロパティを取得|VBA練習問題(2月5日)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
6.繰り返し処理(For Next)|VBA入門
7.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.マクロはどこに書くの(VBEの起動)|VBA入門




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


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



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