Excel(VBA)を使用して、SQL ServerへSQLを実行する際にトランザクション管理をする

サンプルプログラムの概要

SQL Server上のDB「sampleDB」にあるテーブル「employee」に対し
　・同じINSERT文を実行することでKEY制約違反を発生させ、
　・ロールバック
させます。

サンプルプログラム作成

Option Explicit

Sub execTranSample()
    '===============================
    '接続文字列
    '===============================
    'プロバイダ
    Const PROVIDER As String = "MSOLEDBSQL"
    'サーバー名(サーバーのPC名\インスタンス名)
    Const SERVER_NAME As String = "localhost\SQLEXPRESS"
    'DB名
    Const DB_NAME As String = "sampleDB"
    'ユーザー名
    Const USER_NAME As String = "XXXXX"
    'パスワード
    Const PASSWORD As String = "XXXXX"

    Dim con As Object
    Dim conStr As String
    Dim insertSql As String
    Dim command As Object
    Dim errorMessage As String
    
    On Error GoTo conError
    
    '===============================
    'SQL Serverへ接続(Windows認証)
    '===============================
    '接続文字列の組み立て
    conStr = "Provider=" & PROVIDER & ";" & _
              "Data Source='" & SERVER_NAME & "';" & _
              "Initial Catalog='" & DB_NAME & "';" & _
              "Integrated Security=SSPI;" & _
              "DataTypeCompatibility=80;"
            
    '===============================  
    '接続文字列の組み立て(SQL Server認証)
    '===============================
'    conStr = "Provider=" & PROVIDER & ";" & _
'              "Data Source=" & SERVER_NAME & ";" & _
'              "Initial Catalog=" & DB_NAME & ";" & _
'              "User ID=" & USER_NAME & ";" & _
'              "Password=" & PASSWORD & ";" & _
'              "DataTypeCompatibility=80;"
              
              
    'オープン
    Set con = CreateObject("ADODB.Connection")
    con.Open conStr
    
    On Error GoTo insertError
    
    '===============================
    'INSERT文を実行
    '===============================
    Set command = CreateObject("ADODB.Command")

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

    '実行するINSERT文を設定
    insertSql = "INSERT employee (id, name, sex, section) VALUES ('00004', '立花由美', '女', '総務課')"
    
    'INSERT文を実行(1回目)
    With command
        .ActiveConnection = con
        .CommandText = insertSql
        .Execute
    End With
    
    'INSERT文を実行(2回目) ※同じレコードをINSERTすることによりKEY制約違反が発生する
    With command
        .ActiveConnection = con
        .CommandText = insertSql
        .Execute
    End With
    
    'コミット
    con.CommitTrans

    MsgBox "INSERT文を2回実行しました!"
    
    '===============================
    '後片付け
    '===============================
    con.Close
    Set command = Nothing
    Set con = Nothing
    
    Exit Sub

conError:
    '===============================
    '後片付け
    '===============================
    Set con = Nothing

    errorMessage = "接続でエラーが発生しました。" & vbCrLf & vbCrLf & _
            "●エラー番号" & vbCrLf & Err.Number & vbCrLf & vbCrLf & _
            "●エラー内容" & vbCrLf & Err.Description & vbCrLf
    MsgBox errorMessage, vbCritical
    Exit Sub
    
insertError:
    '===============================
    '後片付け
    '===============================
    'ロールバック
    con.RollbackTrans

    con.Close
    Set command = Nothing
    Set con = Nothing

    errorMessage = "INSERT文でエラーが発生しました。ロールバックします。" & vbCrLf & vbCrLf & _
            "●エラー番号" & vbCrLf & Err.Number & vbCrLf & vbCrLf & _
            "●エラー内容" & vbCrLf & Err.Description & vbCrLf
    MsgBox errorMessage, vbCritical
    Exit Sub

End Sub

結果

KEY制約違反が発生しました。

ロールバックにより、「INSERT文を実行(1回目)」で登録したレコードが存在しません。