魂のAccess VBA：Application.SysCmdで極限の進捗バー制御を実装する
Access VBA開発における長年の課題、それは「大量データ処理時におけるユーザーインターフェース（UI）の凍結」である。
数万件、数百万件のレコードをループ処理、あるいは外部RDB（SQL ServerやOracle）とODBC接続してバッチ処理を行う際、画面が「応答なし」となり、強制終了されるのではないかとユーザーが不安に駆られてタスクマネージャーを起動する――このような光景は、設計の甘さが招く典型的な敗北である。
ActiveXコントロールの進捗バー（ProgressBar）は、Officeのビット数（32bit/64bit）の壁やセキュリティパッチによるレジストリ破損によって、容易に動作を停止する。
我々プロフェッショナルが選択すべきは、Accessが標準で提供する、最も堅牢で、かつ外部依存性のないUIフィードバック機構である`Application.SysCmd`だ。
今回は、ステータスバーに進捗バーを描画する`SysCmd`の仕様を骨の髄まで解剖し、実戦に耐えうる「完全カプセル化・描画間引き（Throttling）機能付きラッパークラス」の実装までを徹底的に解説する。
—
1. `Application.SysCmd` の内部メカニズムと定数
`Application.SysCmd` メソッドは、Accessの内部的なシステム処理を制御するための汎用インターフェースである。進捗バーを制御する際には、以下の3つのフェーズ（アクション定数）を正確に制御する必要がある。
| アクション定数 | 値 | 役割 | 必要な引数 |
| :— | :— | :— | :— |
| `acSysCmdInitMeter` | 1 | ステータスバーに進捗バーを初期化・表示する。 | 第2引数: 表示テキスト (String)
第3引数: 最大値 (Long) |
| `acSysCmdUpdateMeter` | 2 | 進捗バーの現在値を更新する。 | 第2引数: 現在値 (Long) |
| `acSysCmdRemoveMeter` | 3 | 進捗バーを破棄し、ステータスバーを標準表示に戻す。 | なし |
メモリとリソースの観点から見た注意点
`SysCmd` による描画は、Windowsのステータスバー領域に対してAccess自体が直接描画（オーナー描画に近い処理）を行う。
そのため、処理の途中でエラーが発生して強制終了した場合、`acSysCmdRemoveMeter` を呼ばないと、Accessのステータスバーに進捗バーの残骸が残り続けるというUIバグを引き起こす。
これは、エラーハンドリングにおける徹底したリソース解放（クリーンアップ）が必須であることを意味している。
—
2. 描画オーバーヘッドと `DoEvents` の罠
多くの開発者が陥る罠が、「ループの1回転ごとに `SysCmd` と `DoEvents` を実行する」という実装だ。
‘ — 避けるべきアンチパターン —
For i = 1 To totalCount
SysCmd acSysCmdUpdateMeter, i
DoEvents ‘ ← これがパフォーマンスを壊滅させる
Next i
なぜこれが悪なのか？
1. 描画のボトルネック: WindowsのUI描画処理は、CPUの演算処理に比べて数百倍遅い。10万回のループで毎回描画を走らせれば、処理時間は数倍〜数十倍に膨れ上がる。
2. `DoEvents` の再入（Reentrancy）リスク: `DoEvents` はOSに制御を戻し、保留中のメッセージ（クリックイベントなど）を処理させる。これにより、処理中にユーザーが別の実行ボタンを連打したり、フォームを閉じたりすることが可能になり、データ破損や異常終了（Runtime Error）の温床となる。
解決策：スロットリング（間引き）とメッセージ制御
- 間引き更新: 進捗バーの更新は「1%変化したとき」または「一定時間（例：100ミリ秒）が経過したとき」のみ実行する。
- 限定的 `DoEvents`: `DoEvents` も毎回呼ぶのではなく、数％刻みで呼ぶか、あるいはWin32 APIの `GetInputState` 等を用いて、入力イベントがあるときのみ限定的に呼び出す。
—
3. 極限のラッパークラス：`clsProgressBar`
オブジェクトのライフサイクル（生成から消滅まで）を厳密に管理するため、`SysCmd` のライフサイクルをクラスモジュールに完全にカプセル化する。
このクラスは、以下のプロフェッショナル要件を満たす。
1. `Class_Terminate` による自己消滅保護: クラスインスタンスが破棄（あるいはエラーによるスコープアウト）された際、自動的にステータスバーをクリアする。
2. 描画スロットリング: 指定した「ステップ（最小更新単位、デフォルト1%）」に達するまで `SysCmd` の呼び出しをスキップし、実行速度低下を防ぐ。
3. 安全な `DoEvents` 制御: ユーザー定義の頻度でしか `DoEvents` を発行しない。
クラスモジュール `clsProgressBar`
（クラス名を `clsProgressBar` として新規クラスモジュールにペーストすること）
Option Compare Database
Option Explicit
‘ ===========================================================================
‘ クラス名: clsProgressBar
‘ 役割: Application.SysCmd を安全かつ高速に制御するラッパークラス
‘ ===========================================================================
Private m_Title As String
Private m_MaxVal As Long
Private m_CurrentVal As Long
Private m_LastUpdatePercent As Long
Private m_StepPercent As Long
Private m_DoEventsFrequency As Long ‘ DoEventsを呼び出すパーセンテージ間隔（0で呼び出さない）
‘ — 初期化 —
Private Sub Class_Initialize()
m_Title = “処理中…”
m_MaxVal = 100
m_CurrentVal = 0
m_LastUpdatePercent = -1
m_StepPercent = 1 ‘ デフォルトは1%刻みで更新
m_DoEventsFrequency = 5 ‘ デフォルトは5%刻みでDoEventsを実行
End Sub
‘ — 終端処理（デストラクタ） —
‘ このクラスのインスタンスが解放された時、確実にステータスバーを復元する
Private Sub Class_Terminate()
On Error Resume Next
Call Clear
End Sub
‘ — パブリックメソッド: 開始 —
Public Sub Begin(ByVal Title As String, ByVal MaxValue As Long, Optional ByVal StepPercent As Long = 1)
If MaxValue <= 0 Then MaxValue = 1
If StepPercent < 1 Or StepPercent > 100 Then StepPercent = 1
m_Title = Title
m_MaxVal = MaxValue
m_StepPercent = StepPercent
m_CurrentVal = 0
m_LastUpdatePercent = 0
‘ SysCmdの初期化
Call SysCmd(acSysCmdInitMeter, m_Title, m_MaxVal)
End Sub
‘ — パブリックメソッド: 更新 —
Public Sub Update(ByVal CurrentValue As Long)
If m_MaxVal = 0 Then Exit Sub
m_CurrentVal = CurrentValue
‘ 現在のパーセンテージを算出
Dim currentPercent As Long
currentPercent = CLng((m_CurrentVal / m_MaxVal) 100)
‘ 境界値制御
If currentPercent > 100 Then currentPercent = 100
If currentPercent < 0 Then currentPercent = 0
' 設定されたステップ（例：1%）以上の変化があった場合のみSysCmdを叩く（スロットリング）
If (currentPercent >= m_LastUpdatePercent + m_StepPercent) Or (currentPercent = 100) Then
Call SysCmd(acSysCmdUpdateMeter, m_CurrentVal)
‘ 指定頻度に基づき、安全にDoEventsを実行
If m_DoEventsFrequency > 0 Then
If (currentPercent Mod m_DoEventsFrequency = 0) Or (currentPercent = 100) Then
DoEvents
End If
End If
m_LastUpdatePercent = currentPercent
End If
End Sub
‘ — パブリックメソッド: 消去 —
Public Sub Clear()
Call SysCmd(acSysCmdRemoveMeter)
End Sub
‘ — プロパティ設定 —
Public Property Let DoEventsFrequency(ByVal Value As Long)
m_DoEventsFrequency = Value
End Property
Public Property Get DoEventsFrequency() As Long
Return m_DoEventsFrequency
End Property
—
4. 実戦での運用：大量レコード処理のシミュレーション
構築した `clsProgressBar` を、実際のデータアクセス（DAO）やループ処理に組み込む際のベストプラクティスを示す。
ここでは、一時テーブルまたはテストデータから10万レコードを走査する処理をシミュレートする。エラーハンドリングに `clsProgressBar` のライフサイクルを委ねることで、コードがどれほど堅牢かつシンプルになるかに注目してほしい。
標準モジュールでの実装例
Option Compare Database
Option Explicit
Public Sub ExecuteHeavyBatchProcess()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim totalRecords As Long
Dim currentCount As Long
‘ 1. プログレスバーのインスタンス生成
‘ このスコープ（ローカル変数）を抜けるか、エラーで中断した時点で
‘ クラスの Class_Terminate が走り、ステータスバーは自動的に初期化される
Dim pb As New clsProgressBar
On Error GoTo Error_Handler
Set db = CurrentDb()
‘ 高速化のため、前方スクロール・読込専用でレコードセットを開く
Set rs = db.OpenRecordset(“SELECT FROM T_TransactionData”, dbOpenForwardOnly, dbReadOnly)
‘ レコード数の取得（前方スクロールの場合は正確なレコード数が即座に取れないため、
‘ 総数が不明な場合はダミーの最大値を設定するか、事前にDCount等で取得する）
totalRecords = DCount(“”, “T_TransactionData”)
If totalRecords = 0 Then
MsgBox “対象データが存在しません。”, vbInformation
Exit Sub
End If
‘ 進捗バーの開始（タイトル、最大値、更新ステップを2%に設定して高速化）
pb.Begin “トランザクションデータを処理中…”, totalRecords, 2
currentCount = 0
Do Until rs.EOF
currentCount = currentCount + 1
‘ — ここに本来の重たい業務ロジックを記述する —
‘ 例: データの検証、別テーブルへのインサート、API送信など
‘ ————————————————
‘ プログレスバーの更新（内部でスロットリングが行われるため、毎ループ呼んでも超高速）
pb.Update currentCount
rs.MoveNext
Loop
‘ 正常終了
pb.Clear
MsgBox “すべての処理が完了しました。”, vbInformation, “完了”
Exit_Handler:
‘ ライフサイクル管理により、オブジェクト変数をNothingにするだけで
‘ ステータスバーは確実にクリアされる
Set pb = Nothing
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not db Is Nothing Then Set db = Nothing
Exit Sub
Error_Handler:
MsgBox “エラーが発生しました: ” & Err.Description, vbCritical, “システムエラー”
Resume Exit_Handler
End Sub
—
5. プロフェッショナルが知るべき Windows API による極限のフリーズ回避
長時間処理（数分以上）を行う場合、VBAの `DoEvents` だけではWindows OSの「ウィンドウマネージャー」に対して「このプロセスは生存している」というシグナルを十分に送れず、画面全体が白く濁り「応答なし」と判定されることがある。
これを完全に防ぐために、Win32 APIの `SendMessage` または `RedrawWindow` を強制し、Accessのメインウィンドウ自体に再描画イベントを強制的に割り込ませる。
Win32 API 宣言部（64bit/32bit両対応）
以下のコードを標準モジュールの最上部に記述し、VBAの描画エンジンに対してOSレベルから描画を強制する。
If VBA7 Then
Private Declare PtrSafe Function GetActiveWindow Lib “user32” () As LongPtr
Private Declare PtrSafe Function UpdateWindow Lib “user32” (ByVal hwnd As LongPtr) As Long
Else
Private Declare Function GetActiveWindow Lib “user32” () As Long
Private Declare Function UpdateWindow Lib “user32″ (ByVal hwnd As Long) As Long
End If
”’
”’ DoEventsよりも安全で、再入（イベントの多重発生）を防ぎつつ、画面の「応答なし」を回避する。
”’
Public Sub ForceRedrawAccess()
On Error Resume Next
#If VBA7 Then
Dim hwnd As LongPtr
#Else
Dim hwnd As Long
#End If
‘ Accessのメインウィンドウハンドルを取得し、描画を強制更新
hwnd = GetActiveWindow()
If hwnd <> 0 Then
UpdateWindow hwnd
End If
End Sub
この `ForceRedrawAccess` を、先ほど構築したラッパークラス `clsProgressBar` の `Update` メソッド内で、`DoEvents` の代わりに（あるいは併用して）数％ごとに実行する。これにより、マウスクリックなどの割り込みイベントを受け付けることなく、画面表示だけを確実に「生きている」状態に保つことが可能になる。
—
6. アーキテクトの思想：システムを「掌握」するということ
システム開発における美しさとは、単に「動く」ことではない。
不測のエラー、想定を超える大量のデータ、レガシーなインフラ環境、それらすべての「最悪のシナリオ」を予見し、先手を打っておくことだ。
今回紹介した `Application.SysCmd` による進捗バーの制御は、以下の思想を体現している。
- 依存性の排除: 外部のアクティブXコントロールを一切排除し、Access本体のネイティブ機能のみで完結させる。
- ライフサイクルの厳格化: クラスのデストラクタ（`Class_Terminate`）をフックにし、リソースの消滅時に必ず元のクリーンな状態へと復元する。
- パフォーマンスへの敬意: 描画スロットリング（間引き）を実装し、UI表現のために業務処理そのもののパフォーマンスを犠牲にしない。
この頑強なコードを君のライブラリに加え、レガシーシステムをモダンな、かつ堅牢なシステムへと昇華させてほしい。
