【Access】AccessVBA：ADOでトランザクション制御

業務で使用する場合、トランザクション制御ができないと困ることが多いです。
そこで、ADO接続でMySQLのテーブルを複数更新かけて
途中でエラーになった時のロールバック方法等の備忘録です。

'----
Dim gobjCon As New ADODB.Connection
Dim objCmd As New ADODB.command

    '*** データベースを開く
    gobjCon.ConnectionString = conConnectStr
    gobjCon.Open

    '*** トランザクション開始
    gobjCon.BeginTrans

    ' コマンド設定
    objCmd.ActiveConnection = gobjCon

    '*** 出庫基本
    strSql = "UPDATE d_ship_base SET"
    strSql = strSql & " cutoff_flag = " & C_フラグ_済 & ""
    strSql = strSql & " WHERE owner_crp_id = " & crpId & ""                                    ' 対象取引先ID
    strSql = strSql & "   AND inv_date BETWEEN '" & m_fromDate & "' AND '" & m_toDate & "'"
    objCmd.CommandText = strSql
    ' SQL実行
    objCmd.Execute

    strSql = "INSERT INTO d_adjust( "
    strSql = strSql & "  adj_no"
    strSql = strSql & "  ,adj_note"         '備考
    strSql = strSql & "  ,add_dt"           '登録日時
    strSql = strSql & ") "
    strSql = strSql & "VALUES ( "
    strSql = strSql & " '" & mstrAdjNo & "'"
    strSql = strSql & "  ,'" & Nz(Me.txtNote.value) & "'"
    strSql = strSql & "  ,'" & Now & "'"
    strSql = strSql & ") "
    objCmd.CommandText = strSql
    ' SQL実行
    objCmd.Execute

    '*** コミット
    gobjCon.CommitTrans

    '*** 後処理
    gobjCon.Close: Set gobjCon = Nothing

なお、insertやupdateを別メソッドにしてメイン処理の中で
チェック処理や複数のinsertやupdateのメソッドを呼んで制御する手法を好んで書いています。

例として

'***************************
' 更新ボタン
'***************************
Private Sub cmd更新_Click()
Dim sMsg As String

On Error GoTo Error

    '=================
    ' 入力チェック
    '=================
    If funCheckInput = False Then
        Exit Sub
    End If
    
    '=================
    ' 確認メッセージ
    '=================
    sMsg = "登録します。よろしいですか？"
    If MsgBox(sMsg, vbInformation + vbYesNo + vbDefaultButton2, C_MSG_TITLE) = vbNo Then
        Exit Sub
    End If

    '*** データベースを開く
    gobjCon.ConnectionString = conConnectStr
    gobjCon.Open

    '*** トランザクション開始
    gobjCon.BeginTrans
    
    '=================
    ' MAIN処理
    '=================
    ' 在庫調整データ追加
    If funDAdjust_Insert() = False Then
        GoTo Error_Rollback
    End If

    ' 在庫更新
    If funStock_Update(mstrAdjNo) = False Then
        GoTo Error_Rollback
    End If

    '*** コミット
    gobjCon.CommitTrans

    '*** 後処理
    gobjCon.Close: Set gobjCon = Nothing

    '=================
    ' 終了メッセージ
    '=================
    MsgBox "登録処理が正常に終了しました。", vbInformation + vbOKOnly, C_MSG_TITLE

Exit Sub
Error:
    MsgBox "エラーが発生しました。エラー内容：" & ERR.Description & Chr$(10), vbCritical, C_MSG_TITLE
    
Error_Rollback:
On Error Resume Next
    ' ロールバック
    gobjCon.RollbackTrans
    ' 後処理
    gobjCon.Close: Set gobjCon = Nothing
End Sub

こうするとロジックは物凄い見やすくなるし途中で修正が入っても大丈夫。
基本クエリは帳票でしか使用しませんので
モジュール内で検索すれば、途中でテーブル変更があったとかの場合にも
影響調査がしやすいです。
この場合は、gobjConをグローバル変数にします。