時間がかかるループ処理を強制終了する方法は、Ctrl+Breakキーを押下する方法が一般的です。
ですが、ユーザーにCtrl+Breakキーを押させるというのスマートではありませんし、
強制的にループを抜けるのでシステムエラーが表示されたりもします。
そもそも強制的にループを抜けるという処理をユーザーにしてほしくはありませんが、どうしてもという要望もあります。
今回の要望はメールを送信するループ処理があり、実行した後に「しまった！ファイルを添付し忘れた！」という事態になった場合の「緊急停止」ボタンがほしいというものでした。
それでは実装していきましょう。
実装方法
今回は実装方法を簡単に表現するため、1秒ずつWaitしながらカウントアップ、値をカウンタフィールドにセットするループを作成します。
カウントアップボタンのクリックイベントのプログラムは以下の通りです。
'------------------------------------------------------------
' 処理内容:カウントアップ
' 引数:なし
' 戻り値:なし
'------------------------------------------------------------
Private Sub cmdカウントアップ_Click()
Dim cnt As Integer
'実行フラグをONならすでに実行中なので処理中止
'実行フラグがOFFならONにして処理開始（ループ中にDoEventを発生させるためメール送信の二重起動を防ぐ）
If flgCnt = True Then
Exit Sub
Else
'処理を開始する際に実行フラグをON,中止フラグをOFFに初期化
flgCnt = True
flgStop = False
End If
'ｶｳﾝﾀの初期化
cnt = 0
Do While cnt < 1000
'カウントアップ
cnt = cnt + 1
'1秒waitする
Sleep 1000
'ループの停止ができるように処理を追加
DoEvents
'停止フラグがONなら処理を中止する
If flgStop Then
flgStop = False
MsgBox "処理を中止しました。", vbOKOnly + vbCritical, "緊急停止"
Exit Do
Else
Me.txtカウンタ = cnt
End If
Loop
End_proc:
'処理が正常終了したら実行中ﾌﾗｸﾞをOFFにする
flgCnt = False
Exit Sub
End Subあれこれ書いてますが、ポイントはwhileループの中に「Do Event」を記述する点です。
この命令によりwhileの最中でもイベントを受け取ることができます。
緊急停止ボタンクリック時に停止フラグ（flgStop）をTrueにすることで、ループの最中にイベント取得で停止フラグがTrueの場合に処理を抜けられるようにしています。
Do Eventを記述することのリスク
とはいえ、「Do Event」を記述することで、ループ中に何をされるか分からないというリスクが発生します。
例えば・・・
- ボタンをクリックしてループ処理を開始したのに、ループ処理中にまた同じボタンをクリックされて二重ループが発生する。
- ループ中に「☓」ボタンクリックでフォーム自体を閉じられる。
こういったことがないように、「DoEvent」で処理させたい以外の機能（今回は緊急停止ボタンクリック以外の機能）を全て動作しないように制御しておく必要があります。
ファンクションキーの割当があれば、ファンクションキーの制御も必要です。
先のサンプルソースでは以下の部分で、二重起動を防いでいます。
'実行フラグをONならすでに実行中なので処理中止
'実行フラグがOFFならONにして処理開始（ループ中にDoEventを発生させるためメール送信の二重起動を防ぐ）
If flgCnt = True Then
Exit Sub
Else
'処理を開始する際に実行フラグをON,中止フラグをOFFに初期化
flgCnt = True
flgStop = False
End If上記のように実行中フラグがTrueなら動作しないようにしておきましょう。
尚、停止フラグと実行中フラグはprivate変数として先に定義済みです。
その他
今回はsleep()関数でカウントアップ時1秒sleepさせていますが、sleep関数はAPIなので事前にモジュール内で宣言が必要です。
‘sleep関数用
Private Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
コメント