フォルダコピーとファイルの移動　～ ④ ログを出力 ～

Excel VBA 作ってみた

昨日は、あるフォルダを別のフォルダへ移動する操作を、連続で行うところまでを作成した。
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)
    
    ' 階層Ａの移動先フォルダフルパス。
    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)
    ' 階層Ａのフォルダループ用。
    Dim FolderA As Scripting.Folder
    ' 階層Ｂのフォルダループ用。
    Dim FolderB As Scripting.Folder
    ' 階層Ｃのフォルダループ用。
    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.列も、いつもの関数で対応。

あと二回ぐらい続きます。

参考まで。