フォルダコピーとファイルの移動 ~ ④ ログを出力 ~
昨日は、あるフォルダを別のフォルダへ移動する操作を、連続で行うところまでを作成した。
infoment.hatenablog.com
今日も、昨日の続きから。
うっかりしてた。移動の成否と、移動前後のフォルダパスを記録しなければ
ならなかった。記録用ログファイルは、所定のテキストファイルを準備して
書き出すなどの方法がある。しかし今回は、マクロで操作しているのだから
マクロブックに書き出すことにした。
シートのオブジェクト名は、「LogSheet」とした。
まず移動したファイルパスの取得だが、これは以前紹介した↓を再利用する。
' 指定フォルダ下のファイルパスを全て取得。 Function FileList(folder_path As String) As Variant FileList = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & folder_path & """ /b /s /a-d").StdOut.ReadAll, vbCrLf), ".") End Function
次いで、昨日作成したサブプロシージャ:MoveTargetFolderを、名前を
そのままにファンクションプロシージャにした。戻り値はBooleanとし、
移動がうまくいけばTrueを、駄目ならFalseを返す。
またその他、移動前後のパスを返したい。返したいものが複数出てきて
どうしようかと悩んだが、自主禁断のByRefを使用することとした。
Function MoveTargetFolder(folder_a As String, folder_b As String, _ ByRef before_list As Variant, _ ByRef after_list As Variant) As Boolean On Error GoTo er: ' パス用配列の初期化。 before_list = Array() after_list = Array() ' 移動する部分のフォルダパス。 Dim MovePartName As String MovePartName = folder_a & "\" & folder_b ' 移動元のパス。 Dim SrcFolderPath As String SrcFolderPath = FSO.BuildPath(SrcParentFolderPath, MovePartName) ' 移動先のパス。 Dim DstFolderPath As String DstFolderPath = FSO.BuildPath(DstParentFolderPath, MovePartName) ' 階層Aの移動先フォルダフルパス。 Dim DstFolderAPath As String DstFolderAPath = FSO.BuildPath(DstParentFolderPath, folder_a) ' 移動先のフォルダ有無確認。なければ作成する。 If Not FSO.FolderExists(DstFolderAPath) Then MkDir DstFolderAPath End If ' 移動前のパス取得。 before_list = FileList(SrcFolderPath) ' フォルダ移動。 FSO.MoveFolder SrcFolderPath, DstFolderPath ' 移動成功。 MoveTargetFolder = True ' 移動後のパス取得。 after_list = FileList(DstFolderPath) Exit Function er: ' 移動失敗。 MoveTargetFolder = False End Function
ここまで作って、気が付いた。戻り値がTrueでもFalseでも記録は必要な訳で。
条件分岐を設けるのも煩雑なので、せっかくの戻り値は使わず、結果をベタと
貼り付けることにした。
Sub MoveFolders(specified_date As Date) ' 階層Aのフォルダループ用。 Dim FolderA As Scripting.Folder ' 階層Bのフォルダループ用。 Dim FolderB As Scripting.Folder ' 階層Cのフォルダループ用。 Dim FolderC As Scripting.Folder ' 移動前リスト。 Dim BeforeList As Variant ' 移動後リスト。 Dim AfterList As Variant ' 記録用テーブル。 Dim Tb As ListObject Set Tb = LogSheet.ListObjects(1) For Each FolderA In FSO.GetFolder(SrcParentFolderPath).SubFolders For Each FolderB In FSO.GetFolder(FolderA).SubFolders For Each FolderC In FSO.GetFolder(FolderB).SubFolders If IsMovable(FolderC.Name, specified_date) Then MoveTargetFolder FolderA.Name, FolderB.Name, _ BeforeList, AfterList ' 移動記録。 With Tb.ListRows.Add .Range(2).Resize(UBound(BeforeList) + 1) = _ WorksheetFunction.Transpose(BeforeList) If UBound(AfterList) <> -1 Then .Range(3).Resize(UBound(AfterList) + 1) = _ WorksheetFunction.Transpose(AfterList) End If .Range(5).Resize(UBound(BeforeList) + 1) = Now End With End If Next Next Next End Sub
それでは昨日と同様、↓ こちらで試してみよう。
Sub test() MoveFolders #8/1/2022# End Sub
結果、このように出力された。一応、成功したようだ。
ちなみに、何らかの理由により移動が失敗すると、↓ の結果となる。
成功/失敗の表記は関数で対応。
No.列も、いつもの関数で対応。
あと二回ぐらい続きます。
参考まで。