DAO.RecordsetのAbsolutePositionを極めよ：百万件の闇を切り裂く極限の進捗制御
レガシーシステムの保全、あるいは限られたリソースの中での高速バッチ処理。私たちは日々、Accessという強烈な諸刃の剣に向き合っている。
数百万件に及ぶレコードの集計、複雑なトランザクション、そして終わりの見えないループ処理。現場のユーザーから「今、何％終わっているのか分からない」「フリーズしているのか区別がつかない」という悲鳴を聞くたびに、私たちは非力なVBAのUIスレッドと格闘することになる。
一般的な入門書は「DoEventsを入れろ」「SysCmdを使え」と口を揃える。だが、シニアエンジニアである我々が求めるのは、そんな表面的なしのぎではない。
今回は、DAOの`Recordset`が持つ隠されたポインタ制御の真髄、`AbsolutePosition`を活用した極限の進捗更新と、UX（ユーザー体験）を最大化するアーキテクチャを解説する。
—
1. なぜ「AbsolutePosition」なのか？ オブジェクトの重量を知る者たちの選択
進捗率を計算する際、最も愚かなアプローチは「毎回 `DCount` を発行する」、あるいは「毎回ループ内でレコードセットの先頭からカウントし直す」ことだ。これらはデータベースのI/Oを爆発させ、ネットワーク（あるいはローカルのJet/ACEエンジン）を窒息死させる。
ここで`Recordset.RecordCount`を使おうとする者も多いが、ここに最初の罠がある。
DAOのダイナセット（`dbOpenDynaset`）やスナップショット（`dbOpenSnapshot`）において、`.RecordCount`は「これまでにアクセスされたレコードの数」しか正確に返さないことが多い。まだフェッチされていない残りのレコードを数えるために、エンジンは暗黙的に全件走査を行う。これでは高速化どころか、二重のオーバーヘッドを生む。
そこで登場するのが `AbsolutePosition` だ。
‘ AbsolutePositionの概念
‘ 0ベースのインデックスを返し、現在のレコードポインタの絶対位置を示す
Dim currentPos As Long
currentPos = rs.AbsolutePosition + 1 ‘ 1始まりに補正
このプロパティは、単なる「現在の行番号」ではない。適切に構築されたレコードセット（特に`dbOpenSnapshot`によるメモリ上の静的スナップショット）において、ポインタの移動コストを最小限に抑えつつ、現在の処理位置をO(1)のオーダーで引き出すための強力な武器となる。
—
2. 圧倒的なパフォーマンスを生む設計：スナップショットとバルク処理の融合
数百万件のデータを扱うバッチ処理において、テーブルロックや不必要なトランザクションは御法度だ。以下のコードは、限界まで無駄を削ぎ落とした「進捗バー動的更新エンジン」の完成形である。
ここでは、無駄なUI描画コスト（リペイント地獄）を回避するため、一定間隔（例：1,000件ごと）でのみプログレスバーとステータスバーを更新するロジックを実装している。毎ループのUI更新は、VBAにおいてはそれだけで処理時間の8割を奪う毒薬となるからだ。
実装コード：限界駆動型の高速プロセッシング
Option Explicit
‘ Windows API: フォームの再描画を抑制し、描画負荷を極限まで下げる場合などに使用
Private Declare PtrSafe Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
Public Sub ExecuteHeavyBatchProcess()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim totalRecords As Long
Dim currentPos As Long
Dim progressRatio As Double
Dim updateInterval As Long
‘ 計測用タイマー
Dim startTime As Double
startTime = Timer
Set db = CurrentDb
‘ 【重要】パフォーマンスの極限追求のため、更新不要ならSnapshotを使用する
strSQL = “SELECT ID, TargetData, ProcessedFlag FROM T_MassiveData WHERE ProcessedFlag = False;”
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot, dbOpenForwardOnly)
‘ レコードが存在しない場合の早期脱出
If rs.EOF Then
MsgBox “処理対象のレコードが存在しません。”, vbInformation
GoTo Cleanup
End If
‘ RecordCountを正確に取得するため、一度末尾へジャンプして戻る
‘ ※ForwardOnlyの場合は使えないため、Snapshotを使用している点に注目
rs.MoveLast
totalRecords = rs.RecordCount
rs.MoveFirst
‘ 更新頻度の動的決定（全件数の1%、ただし最低10件、最大5000件に制限）
updateInterval = totalRecords \ 100
If updateInterval < 10 Then updateInterval = 10
If updateInterval > 5000 Then updateInterval = 5000
‘ ユーザーフォームの初期化（ここではStatusBarを例示）
SysCmd acSysCmdInitMeter, “バッチ処理を実行中…”, totalRecords
‘ メインループ：極限の速度を維持しつつ、ポインタを回す
Dim counter As Long
counter = 0
Do While Not rs.EOF
‘ ————————————————–
‘ ここに実際の重いビジネスロジックを記述
‘ 例: データの変換、外部API連携、別テーブルへの書き込み等
‘ ————————————————–
‘ AbsolutePositionを用いた位置の特定 (0始まりなので +1)
currentPos = rs.AbsolutePosition + 1
‘ 一定間隔でのみUIを更新（毎回更新するとVBAは劇的に遅くなる）
If counter Mod updateInterval = 0 Or currentPos = totalRecords Then
‘ ステータスバーの更新
SysCmd acSysCmdUpdateMeter, currentPos
‘ アプリケーションの応答性を維持しつつ、描画落ちを防ぐ
DoEvents
End If
counter = counter + 1
rs.MoveNext
Loop
‘ 完了処理
SysCmd acSysCmdRemoveMeter
MsgBox “処理が完了しました。” & vbCrLf & _
“処理件数: ” & totalRecords & “件” & vbCrLf & _
“所要時間: ” & Format(Timer – startTime, “0.00”) & “秒”, vbInformation
Cleanup:
‘ 【鉄則】オブジェクトの明示的解放によるメモリリークの根絶
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Set db = Nothing
End Sub
—
3. チーフアーキテクトが教える「現場の罠」と回避策
このコードは美しく、かつ高速に動作する。しかし、Access VBAの深淵を覗く者であれば、以下の罠に気づくはずだ。
罠1：`AbsolutePosition` が `-1` を返す瞬間
`Recordset` の種類（例えば `dbOpenDynaset` で非同期ポインタフェッチが走っている最中など）によっては、`AbsolutePosition` が正確な値を返さず `-1` を吐き出すことがある。
これを防ぐため、上記のコードでは `dbOpenSnapshot` を明示的に指定し、メモリ上に静的な結果セットを固定している。数百万件であっても、インデックスが効いたクエリのスナップショットであれば、メモリ消費は現代のPC環境において許容範囲内である。メモリケチってパフォーマンスを落とすのは、プログラマーの怠慢でしかない。
罠2：UIスレッドの凍結と `DoEvents` のジレンマ
`DoEvents` は諸刃の剣だ。これを挟むことでユーザーが「キャンセル」ボタンを押せるようになる反面、イベントの再入（Reentrancy）リスクが生じる。
もしユーザーが処理中に再度ボタンを連打した場合、同一のプロシージャが二重起動し、データベースの競合や予期せぬクラッシュを引き起こす。
これを防ぐためには、モジュールレベルのフラグ（`isProcessing As Boolean`）による排他制御を必ず組み合わせることだ。
Private isProcessing As Boolean
Public Sub SafeExecute()
If isProcessing Then
MsgBox “現在、別のプロセスが実行中です。”, vbExclamation
Exit Sub
End If
isProcessing = True
On Error GoTo ErrorHandler
‘ ここにメイン処理を記述
ErrorHandler:
If Err.Number <> 0 Then
MsgBox “エラー発生: ” & Err.Description, vbCritical
End If
isProcessing = False
‘ オブジェクト解放処理…
End Sub
—
4. 総括：レガシーの限界を超えるのは、いつだって「基礎の徹底」だ
Access VBAは、オールドファッションな技術だと言われる。しかし、その背後にあるDAOのアーキテクチャや、OSのリソース管理の原則を正しく理解していれば、現代のモダン言語で作られたバッチ処理にも引けを取らない爆速のシステムを構築できる。
`AbsolutePosition` は、単なるプロパティではない。
巨大なデータべースの海原を進むボットが、自らの現在地を正確に把握するための羅針盤なのだ。この羅針盤を正しく使いこなし、ユーザーに「ストレスフリーなレガシーシステム」を提供することこそ、我々シニアエンジニアの矜持である。
