【Excel VBA】インメモリRecordsetの振り返り：安全・確実な一括同期の仕組み

はじめに

Excel VBAで外部データベースを使わずに一時的なデータ管理やバッチ処理を行う際、インメモリの ADODB.Recordset は非常に強力なツールになってくれます。

特に adLockBatchOptimistic（バッチ更新モード）で開くことで、行ごとの状態管理（.Status）、変更前後の値の追跡（.OriginalValue）、一括確定（.UpdateBatch）や状態リセットといった高度な仕組みが、ADOの標準機能だけで完結します。

この記事では、インメモリRecordsetの基本的なライフサイクルのおさらいを交えつつ、フィールドの Attributes の動作確認、fld.Type による堅牢なバイナリ・通常値の Upsert 判定、論理削除による行管理、そして制約違反を防ぐフェーズ分割型の一括同期設計について整理します。

1. インメモリ Recordset の基本動作と検証コード

まずは、コードを動かしてオープン前後でのステータスやアトリビュートの変化を確認してみます。

Public Sub TestRecordsetBehavior()
    Dim rs As New ADODB.Recordset
    
    ' まだオープン前なのでクローズ状態
    Debug.Assert rs.State = ADODB.ObjectStateEnum.adStateClosed
    
    ' フィールドのスキーマ定義
    rs.Fields.Append "id", adInteger, , FieldAttributeEnum.adFldKeyColumn Or FieldAttributeEnum.adFldIsNullable
    rs.Fields.Append "name", adVarChar, -1, attrib:=0
    
    ' Append段階ではAttributesは未確定・0
    Debug.Assert rs.Fields("id").Attributes = 0
    Debug.Assert rs.Fields("name").Attributes = 0
    
    ' オープン実行
    rs.Open
    
    ' オープン後のデフォルト状態（CursorType = adOpenStatic, LockType = adLockBatchOptimistic）
    Debug.Assert rs.CursorType = ADODB.CursorTypeEnum.adOpenStatic
    Debug.Assert rs.LockType = ADODB.LockTypeEnum.adLockBatchOptimistic
    Debug.Assert rs.State = ADODB.ObjectStateEnum.adStateOpen
    Debug.Assert rs.BOF
    Debug.Assert rs.EOF
    
    ' 【重要】rs.Open の瞬間に、ADOエンジンが型やオプションに応じてAttributesを自動確定・補正する
    Debug.Assert rs.Fields("id").Attributes = (FieldAttributeEnum.adFldKeyColumn Or FieldAttributeEnum.adFldFixed Or FieldAttributeEnum.adFldIsNullable Or FieldAttributeEnum.adFldUpdatable)
    Debug.Assert rs.Fields("name").Attributes = (FieldAttributeEnum.adFldLong Or FieldAttributeEnum.adFldUpdatable)

    ' クローズ実行
    rs.Close

    Debug.Assert rs.State = ADODB.ObjectStateEnum.adStateClosed
End Sub

2. .Attributes が持つ意味と暗黙的設定の仕組み

インメモリRecordsetでは、rs.Open を実行した瞬間に、ADOエンジンが定義されたデータ型やメタデータを基に内部Attributesを自動補正・確定させる という重要な挙動があるようです。
主なフラグの組み合わせと自動付与について次のように調査・確認しました。

• 固定長と可変長の自動判定: adInteger などの固定長型を定義すると、明示しなくても自動的に adFldFixed が付与され、サイズ -1 の adVarChar では可変長・大容量データ扱いとなり adFldLong が付与されるようです
• 書き込み許可（adFldUpdatable）の自動付与: バッチ更新モード等で開かれるため、特段の読み取り専用指定がない限り、各フィールドには自動で adFldUpdatable がセットされるようです
• Null許可（adFldIsNullable）の指定: Nullを許可したい場合は、明示的にadFldIsNullableを付与する必要があるようです
• インメモリ運用上の注意: adFldKeyColumn を明示して主キー扱いにしていても、インメモリRecordset単体では重複データの自動ブロック（一意性制約の強制）までは行ってくれず、あくまでメタデータの保持に留まるため、重複チェック等は自前のロジックで担保する必要があるようです

3. .Status の状態遷移

インメモリ ADODB.Recordset（バッチ更新モード）における、行ごとの .Status プロパティの状態遷移です。

4. 行削除は .Delete ではなく「論理削除フラグ」で管理する

ADOの標準メソッドである .Delete を実行すると行は adRecDeleted になりますが、その直後に .MoveNext 等で別の行へ移動すると、削除行からカーソルが外れて元の行に直接アクセスできなくなるという仕様上の制約があります。

そのため、インメモリでの操作においては、無理に物理削除を使わず、専用のフラグ項目（論理削除）で管理するのが良さそうです。

• スキーマに制御用定数で定義したフラグ列を持たせる
• 削除時は rs.Fields(FIELD_IS_DELETED).Value = True とする
• カーソルが消失せず、後からの状態確認や一括処理（DBへの同期）がスムーズに行える

5. Upsert判定関数 NeedsUpsert の実装

「このフィールドは変更されたか？（または新規行で値が入ったか？）」を判定し、データベース等への Upsert（登録・更新）が必要かどうか を判定する関数です。

コントロール用フィールド（_IsDeleted や _IsSynced など）の判定には、ADODBにおいて未使用の Attributes ビット（ADF_FLD_ROW_CONTROL）を利用し、関数内部で自動的に対象外とする設計にしています。

Option Explicit

' =========================================================================
' 制御用フィールドおよびAttributesの定数定義
' =========================================================================
Private Const FIELD_IS_DELETED       As String = "_IsDeleted"
Private Const FIELD_IS_SYNCED        As String = "_IsSynced"
Private Const ADF_FLD_ROW_CONTROL    As Long = &H8000& ' ユーザー定義の未使用ビット

' =========================================================================
' フィールドの値に変化（または新規入力）があり、Upsertが必要かを判定する
' @param fld       対象の ADODB.Field オブジェクト
' @param isNew     True の場合は新規追加行（NullでなければUpsert対象とする）
' =========================================================================
Public Function NeedsUpsert(fld As Object, Optional ByVal isNew As Boolean = False) As Boolean
    NeedsUpsert = False
    
    ' 制御用フィールド（Attributesにカスタムビットが立っているもの）は常にUpsert対象外とする
    If (fld.Attributes And ADF_FLD_ROW_CONTROL) <> 0 Then Exit Function
    
    Dim valCurr As Variant
    valCurr = fld.Value
    
    ' 1. 追加行（新規行）の場合：Nullでなければ値が入っているためUpsertが必要
    If isNew Then
        If Not IsNull(valCurr) Then NeedsUpsert = True
        Exit Function
    End If
    
    ' 2. 既存行の場合：変更差分チェック
    Dim valOrig As Variant
    valOrig = fld.OriginalValue
    
    ' 双方が Null なら変更なし
    If IsNull(valCurr) And IsNull(valOrig) Then Exit Function
    
    ' 片方だけ Null なら変更あり
    If IsNull(valCurr) Or IsNull(valOrig) Then
        NeedsUpsert = True
        Exit Function
    End If
    
    ' 3. フィールドのデータ型（fld.Type）がバイナリ系かどうかで判定
    If IsBinaryField(fld.Type) Then
        NeedsUpsert = Not AreByteArraysEqual(valCurr, valOrig)
        Exit Function
    End If
    
    ' 4. 通常型（数値、文字列、日付、Booleanなど）の比較
    If valCurr <> valOrig Then
        NeedsUpsert = True
    End If
End Function

' --- 内部ヘルパー: フィールドの型がバイナリ系か判定する ---
Private Function IsBinaryField(dataType As DataTypeEnum) As Boolean
    Select Case dataType
        Case adBinary, adVarBinary, adLongVarBinary
            IsBinaryField = True
        Case Else
            IsBinaryField = False
    End Select
End Function

' --- 内部ヘルパー: バイト配列の等価比較 ---
Private Function AreByteArraysEqual(arr1 As Variant, arr2 As Variant) As Boolean
    AreByteArraysEqual = False
    
    Dim l1 As Long, u1 As Long, l2 As Long, u2 As Long
    l1 = LBound(arr1): u1 = UBound(arr1)
    l2 = LBound(arr2): u2 = UBound(arr2)
    
    ' 要素数が異なる場合は不一致
    If (u1 - l1) <> (u2 - l2) Then Exit Function
    
    ' 両方とも空配列の場合
    If u1 < l1 Then
        AreByteArraysEqual = True
        Exit Function
    End If
    
    Dim i As Long, offset2 As Long
    offset2 = l2 - l1
    
    ' 1バイトずつ比較
    For i = l1 To u1
        If arr1(i) <> arr2(i + offset2) Then Exit Function
    Next i
    
    AreByteArraysEqual = True
End Function

6. 制約違反を防ぐ一括反映（Sync）の設計と実装

インメモリで変更を蓄積した Recordset から外部へ一括反映する際、主キーや一意性制約の競合を防ぐため、処理順序は 「削除 ➔ 更新 ➔ 追加」 のフェーズに完全分割します。

さらに実務的な要件として、以下を組み込んでいます。

• フィールド名の定数化: 制御項目を定数（FIELD_IS_DELETED, FIELD_IS_SYNCED）で一元管理し、コード全体の堅牢性を向上。
• 未使用ビット（カスタムAttributes）の活用: 制御用フィールドに ADF_FLD_ROW_CONTROL (&H8000&) を付与し、NeedsUpsert 内で自動的に変更・Upsert対象から除外する。
• 同期済み行の除外: FIELD_IS_SYNCED が True の行はすでに処理済みとみなし、削除・更新・追加のすべての対象外としてスキップ。
• 新規行の誤削除防止: 削除フラグが立っていても、新規行（adRecNew）であればDBに存在しないため削除処理をスキップする。
• 変更フィールドの抽出: 変更のあったカラム名を Collection にリストアップし、動的なSQL構築に備える。
• エラー発生型ヘルパー: 失敗時は各サブ関数内で Err.Raise を発生させ、トランザクションのロールバック機構へ安全に委譲する。
• 同期後のクリーンアップ: 処理完了後に物理削除やフラグの初期化を行い、状態をクリーンにする。

' =========================================================================
' メイン一括同期プロシージャ
' =========================================================================
Public Sub SyncRecordset(rs As Object)
    If rs.RecordCount = 0 Then Exit Sub
    
    ' トランザクション内で安全に実行することを推奨
    ' db.BeginTrans
    On Error GoTo ErrorHandler
    
    Dim fld As Object
    Dim targetFields As Collection
    
    ' --- Phase 1: 削除処理 (DELETE) ---
    rs.MoveFirst
    Do While Not rs.EOF
        ' 未同期かつ論理削除されている行を対象とする
        If Not IsRowSynced(rs) Then
            If IsRowDeleted(rs) Then
                If rs.Status = ADODB.RecordStatusEnum.adRecModified Then
                    SyncDeleteRow rs
                    rs.Fields(FIELD_IS_SYNCED).Value = True
                End If
            End If
        End If
        rs.MoveNext
    Loop
    
    ' --- Phase 2: 更新処理 (UPDATE) ---
    rs.MoveFirst
    Do While Not rs.EOF
        ' 未同期かつ削除されていない行を対象とする
        If Not IsRowSynced(rs) Then
            If Not IsRowDeleted(rs) Then
                If rs.Status = ADODB.RecordStatusEnum.adRecModified Then
                    Set targetFields = New Collection
                    For Each fld In rs.Fields
                        ' NeedsUpsert 関数内でコントロール用フラグ（ADF_FLD_ROW_CONTROL）は自動的に弾かれる
                        If NeedsUpsert(fld, False) Then
                            targetFields.Add fld.Name
                        End If
                    Next fld
                    
                    If targetFields.Count > 0 Then
                        SyncUpdateRow rs, targetFields
                        rs.Fields(FIELD_IS_SYNCED).Value = True
                    End If
                End If
            End If
        End If
        
        rs.MoveNext
    Loop
    
    ' --- Phase 3: 追加処理 (INSERT) ---
    rs.MoveFirst
    Do While Not rs.EOF
        ' 未同期かつ削除されていない新規行を対象とする
        If Not IsRowSynced(rs) Then
            If Not IsRowDeleted(rs) Then
                If rs.Status = ADODB.RecordStatusEnum.adRecNew Then
                    Set targetFields = New Collection
                    For Each fld In rs.Fields
                        ' NeedsUpsert 関数内でコントロール用フラグ（ADF_FLD_ROW_CONTROL）は自動的に弾かれる
                        If NeedsUpsert(fld, True) Then
                            targetFields.Add fld.Name
                        End If
                    Next fld
                    
                    If targetFields.Count > 0 Then
                        SyncInsertRow rs, targetFields
                        rs.Fields(FIELD_IS_SYNCED).Value = True
                    End If
                End If
            End If
        End If
        
        rs.MoveNext
    Loop
    
    ' --- Phase 4: バッチ更新の確定 ---
    rs.UpdateBatch
    
    ' --- Phase 5: 同期完了後、論理削除フラグが立っている行をインメモリから物理削除 ---
    rs.MoveFirst
    Do While Not rs.EOF
        If IsRowDeleted(rs) Then
            rs.Delete adAffectCurrent
        End If
        rs.MoveNext
    Loop
    
    rs.UpdateBatch
    
    ' --- Phase 6: 残ったすべてのレコードの論理削除フラグ・同期フラグをクリアし、状態をリセット ---
    If rs.RecordCount > 0 Then
        rs.MoveFirst
        Do While Not rs.EOF
            If Not IsNull(rs.Fields(FIELD_IS_DELETED).Value) Then
                rs.Fields(FIELD_IS_DELETED).Value = False
            End If
            If Not IsNull(rs.Fields(FIELD_IS_SYNCED).Value) Then
                rs.Fields(FIELD_IS_SYNCED).Value = False
            End If
            rs.MoveNext
        Loop
        rs.UpdateBatch
    End If
    
    ' db.CommitTrans
    Exit Sub

ErrorHandler:
    ' db.RollbackTrans
    Err.Raise Err.Number, "SyncRecordset", Err.Description
End Sub


' =========================================================================
' 状態判定ヘルパー: 削除行かどうかを判定する
' =========================================================================
Private Function IsRowDeleted(rs As Object) As Boolean
    IsRowDeleted = False
    If Not IsNull(rs.Fields(FIELD_IS_DELETED).Value) Then
        If rs.Fields(FIELD_IS_DELETED).Value = True Then
            IsRowDeleted = True
        End If
    End If
End Function


' =========================================================================
' 状態判定ヘルパー: 処理済（同期済）かどうかを判定する
' =========================================================================
Private Function IsRowSynced(rs As Object) As Boolean
    IsRowSynced = False
    If Not IsNull(rs.Fields(FIELD_IS_SYNCED).Value) Then
        If rs.Fields(FIELD_IS_SYNCED).Value = True Then
            IsRowSynced = True
        End If
    End If
End Function


' =========================================================================
' 独立した行削除関数（失敗時はエラーを発生させる）
' =========================================================================
Private Sub SyncDeleteRow(rs As Object)
    On Error GoTo ErrorHandler
    
    Debug.Print "[DELETE] ID: " & rs.Fields("id").Value
    ' TODO: データベース側の DELETE SQL 実行など
    
    Exit Sub
ErrorHandler:
    Err.Raise Err.Number, "SyncDeleteRow", "削除処理に失敗しました (ID: " & rs.Fields("id").Value & "): " & Err.Description
End Sub


' =========================================================================
' 独立した行更新関数（失敗時はエラーを発生させる）
' =========================================================================
Private Sub SyncUpdateRow(rs As Object, changedFields As Collection)
    On Error GoTo ErrorHandler
    
    Debug.Print "[UPDATE] ID: " & rs.Fields("id").Value & " (変更フィールド数: " & changedFields.Count & ")"
    ' TODO: changedFields を用いた動的 UPDATE SQL の構築・実行
    
    Exit Sub
ErrorHandler:
    Err.Raise Err.Number, "SyncUpdateRow", "更新処理に失敗しました (ID: " & rs.Fields("id").Value & "): " & Err.Description
End Sub


' =========================================================================
' 独立した行追加関数（失敗時はエラーを発生させる）
' =========================================================================
Private Sub SyncInsertRow(rs As Object, targetFields As Collection)
    On Error GoTo ErrorHandler
    
    Debug.Print "[INSERT] 新規行の登録 (対象フィールド数: " & targetFields.Count & ")"
    ' TODO: targetFields を用いた動的 INSERT SQL の構築・実行
    
    Exit Sub
ErrorHandler:
    Err.Raise Err.Number, "SyncInsertRow", "新規追加処理に失敗しました: " & Err.Description
End Sub

おわりに

本記事では、インメモリ ADODB.Recordset の基本仕様から、Attributesの活用、バイナリ判定、そしてフェーズ分割された安全な一括同期の仕組みまでを整理してきました。

「本当にこの設計で、どんな特殊なデータや例外ケースでも破綻せずに耐えられるか？」
「もっとコードの意図が自然に伝わる、無駄のない構造にできないか？」

こうして細部までこだわり、VBAという限られた環境のなかでも妥協せずに仕組みをブラッシュアップしていくプロセスそのものが、プログラムの耐久性を高めてくれると感じています。

これからも、ブラックボックスになりがちな標準機能の挙動にきちんと向き合い、自信を持って現場で使える「安全・確実なコード」を積み重ねていきたいと思います。