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

この記事では
VBAからSQL ServerへSQLを実行する際のトランザクション管理の
手順を記載します!

処理の順番は
 1.SQL Serverへ接続
 2.トランザクション開始(BeginTrans)
 3.SQL実行
 4.コミット(CommitTrans) または
   ロールバック(RollbackTrans)
となります!

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

以下のテーブル「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"

    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へ接続
    '===============================
    '接続文字列の組み立て
    conStr = "Provider=" & PROVIDER & ";" & _
              "Data Source='" & SERVER_NAME & "';" & _
              "Initial Catalog='" & DB_NAME & "';" & _
              "Integrated Security=SSPI;" & _
              "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回目)」で登録したレコードが存在しません。

タイトルとURLをコピーしました