AccessVBAで毎回書かない！SQL実行の定型処理を行うベストプラクティス

    Dim db As DAO.Database
    Set db = CurrentDb

'---------------------------------------------------------
'  プロシージャ名：gf_EXEC_SQL
'  機能　　：Access でSQL文を実行します。
'
'  【引数】
'    strSqlStatement ：実行するSQL文
'    [objRecordset]  ：SELECT文の結果を受け取るRecordset（省略可能）
'
'  【戻り値】
'    True  … 正常終了
'    False … エラー発生
'
'  【処理概要】
'    ・Recordset指定が無い場合 → Executeで更新系SQL実行
'    ・Recordset指定がある場合 → OpenRecordsetで結果セットを返す
'
'  【使用例】
'    '--- SELECT文（結果をRecordsetで取得）---
'    Dim rs As DAO.Recordset
'
'    Call gf_EXEC_SQL("SELECT * FROM T_社員", rs)
'
'    '--- 更新系SQL（INSERT/UPDATE/DELETEなど）---
'    Call gf_EXEC_SQL("DELETE FROM T_社員 WHERE ID=1")
'---------------------------------------------------------
Public Function gf_EXEC_SQL(strSqlStatement As String, Optional objRecordset)

    On Error GoTo err_Exec_SQL

    Dim l_db As DAO.Database

    '=== 現在のDBを取得 ===
    Set l_db = CurrentDb()

    '=== Recordset引数の有無で処理分岐 ===
    If IsMissing(objRecordset) Then
        '--- 更新系SQLを実行（結果は返さない）---
        l_db.Execute strSqlStatement
    Else
        '--- SELECT文を実行し結果セットを返す ---
        Set objRecordset = l_db.OpenRecordset(strSqlStatement, DB_OPEN_SNAPSHOT)
    End If

    gf_EXEC_SQL = True

    Exit Function


err_Exec_SQL:

    '=== エラー処理 ===
    MsgBox "【gf_EXEC_SQL】SQL実行中にエラー発生" & vbCrLf & _
           "番号：" & Err.Number & vbCrLf & _
           "内容：" & Err.Description, vbCritical

    Debug.Print "[SQL Error] " & strSqlStatement

    gf_EXEC_SQL = False

End Function

    Dim rs As DAO.Recordset

    Call gf_EXEC_SQL("SELECT * FROM T_社員", rs)

    Call gf_EXEC_SQL("DELETE FROM T_社員 WHERE ID=1")

'================================================================================
'  プロシージャ名：gf_TRAN_SQL
'  機能　：複数SQLをトランザクションで実行します。
'
'  【引数】
'    arrSqlStatement ：SQL文配列（Variant配列）
'
'  【戻り値】
'    True  … Commit成功
'    False … エラー時Rollback
'================================================================================
Public Function gf_TRAN_SQL(arrSqlStatement As Variant) As Boolean

    On Error GoTo err_TRAN_SQL

    Dim l_ws As DAO.Workspace    ' Workspace（トランザクション管理）
    Dim l_db As DAO.Database     ' Database
    Dim l_lp As Long             ' ループカウンタ
    Dim l_sql As String          ' 実行SQL

    '=== オブジェクト取得 ===
    Set l_ws = DBEngine.Workspaces(0)
    Set l_db = CurrentDb

    '=== トランザクション開始 ===
    l_ws.BeginTrans

    '=== SQL実行 ===
    For l_lp = LBound(arrSqlStatement) To UBound(arrSqlStatement)

        l_sql = Nz(arrSqlStatement(l_lp), "")

        If l_sql <> "" Then
            l_db.Execute l_sql, dbFailOnError
        End If

    Next l_lp

    '=== Commit ===
    l_ws.CommitTrans

    gf_TRAN_SQL = True
    Exit Function


err_TRAN_SQL:

    '=== Rollback ===
    On Error Resume Next
    l_ws.Rollback
    On Error GoTo 0

    MsgBox "【gf_TRAN_SQL】トランザクションエラー" & vbCrLf & _
           "Index : " & l_lp & vbCrLf & _
           "SQL   : " & l_sql, vbCritical

    Debug.Print "Index : " & l_lp
    Debug.Print "SQL   : " & l_sql

    gf_TRAN_SQL = False

End Function

Private Sub sample_TRAN_SQL()

    Dim arrSql() As String

    ReDim arrSql(2)

    arrSql(0) = "DELETE FROM T_受注 WHERE 受注日 < #2024-01-01#"
    arrSql(1) = "INSERT INTO T_ログ (内容) VALUES ('受注削除実行')"
    arrSql(2) = ""   ' 空文字は自動スキップされる

    If gf_TRAN_SQL(arrSql) Then
        MsgBox "処理完了"
    Else
        MsgBox "エラー"
    End If

End Sub