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

VBAを100本の練習問題で鍛えます
最終更新日: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データを取得(マスタ結合&抽出)


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

TOROW関数(配列を横1行の配列にして返す)|エクセル入門(2022-10-31)
TOCOL関数(配列を縦1列の配列にして返す)|エクセル入門(2022-10-31)
CHOOSECOLS関数(配列から複数の指定された列を返す)|エクセル入門(2022-10-29)
CHOOSEROWS関数(配列から複数の指定された行を返す)|エクセル入門(2022-10-29)
WorksheetFunctionの効率的な使い方とスピル新関数の利用|VBA入門(2022-10-27)
VSTACK関数(配列を縦方向に順に追加・結合)|エクセル入門(2022-10-25)
HSTACK関数(配列を横方向に順に追加・結合)|エクセル入門(2022-10-25)
LAMBDA以降の新関数の問題と解説(配列操作関数編)|エクセル入門(2022-10-24)
LAMBDA以降の新関数の問題と解説(ヘルパー関数編)|エクセル入門(2022-10-24)
LAMBDA以降の新関数の問題集|エクセル入門(2022-10-24)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Excelショートカットキー一覧|Excelリファレンス
7.並べ替え(Sort)|VBA入門
8.マクロって何?VBAって何?|VBA入門
9.エクセルVBAでのシート指定方法|VBA技術解説
10.ExcelマクロVBAの基礎を学習する方法|エクセルの神髄




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


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



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