フォルダコピーとファイルの移動　～ ⑤ 処理の中断～

先日は、フォルダの移動結果をシートに入力するところまでを作成した。
infoment.hatenablog.com
今日も、先日の続きから。

リクエストによれば、処理の中断処理が必要だ。しかも非常停止ではなく、
繰返しを抜ける処理だ（サイクル停止）。そこで、シートに中断ボタンを
設けることにした。ついでに、処理を開始する移動ボタンも準備しよう。

二つのボタンは共に、ActiveXコントロールのCommandButtonとした。
オブジェクト名：

移動：cbDoMove
中断：cbStop

中断ボタンが押されたことを検知させるために、標準モジュールに
Public変数を一つ設ける。

' 中断用フラグ。
Public StopFlag As Boolean

各ボタンのクリックイベントは、以下のとおり。
※シートモジュールに設置。

Private Sub cbDoMove_Click()
    Dim SpecifiedDate As Variant
        SpecifiedDate = InputBox("基準日を入力してください。", _
                                 "基準日入力", Date)
        If Not IsDate(SpecifiedDate) Then
            MsgBox "日付以外が入力されたため、処理を中断します。"
            Exit Sub
        End If
        
        ' 中断用フラグ初期化。
        StopFlag = False
        
    Call MoveFolders(CDate(SpecifiedDate))
End Sub

Private Sub cbStop_Click()
    StopFlag = True
End Sub

フォルダおよびファイル移動用プロシージャに、中断処理を追加。

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
                                       
                        ' 中断ボタンの押下検出用。
                        Application.Wait [Now()+"00:00:02"]
                        
                        ' 移動記録。
                        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
                        
                        ' 中断ボタンが押された時の処理。
                        DoEvents
                        If StopFlag Then
                            GoTo StopTrap:
                        End If
                            
                    End If
                Next
            Next
        Next
        
        Exit Sub
        
StopTrap:
    MsgBox "処理が中断されました。"
        
End Sub