トランザクション（ADO）BeginTrans、CommitTrans、RollbackTrans

2017/09/20 2017/10/23

ADO でのトランザクション処理

【書式】

Sub Sample_Transaction

	＜＜データベース接続＞＞
	On Error GoTo ErrHandler	……>	エラートラップ開始
	connection_object.BeginTrans	……>	トランザクション開始
	処理１　　　　　　処理２　　　　　　・　　　　　　・　　　　　　・
	connection_object.CommitTrans	……>	処理の確定
	On Error GoTo 0	……>	エラートラップ終了
	＜＜終了処理等＞＞
	Exit Sub	……>	処理が正常に行われた場合は終了
ErrHandler:		……>	エラーが発生した時、ここまで移動
	connection_object.RollbackTrans	……>	すべての処理を破棄する
	＜＜終了処理等＞＞

End Sub

　※ connection_object …… Connection オブジェクト

BeginTrans メソッド

【書式】

object.BeginTrans

引数・戻り値

object ・・・対象となる Connection オブジェクトを指定します。
戻り値・・・トランザクションのネストのレベルを示す長整数型（Long）の値。

BeginTrans メソッドを呼び出すと、CommitTrans メソッドまたは RollbackTrans メソッドを呼び出しトランザクションを終了するまで、変更は実行されません。

CommitTrans メソッド

【書式】

object.CommitTrans

CreateObject 関数

object ・・・対象となる Connection オブジェクトを指定します。

CommitTrans メソッドを呼び出すとその接続上で開いているトランザクションに加えた変更が保存され、トランザクションが終了します。開いているトランザクションが存在しない場合、エラーが発生します。

RollbackTrans メソッド

【書式】

object.RollbackTrans

CreateObject 関数

object ・・・対象となる Connection オブジェクトを指定します。

RollbackTrans メソッドを呼び出すとその接続上で開いているトランザクションに加えた変更がすべて元に戻され、トランザクションが終了します。開いているトランザクションが存在しない場合、エラーが発生します。

トランザクション使用例

サンプルVBAソースその１

　
Sub Sample_Transaction1()

    '参照設定:Microsoft ActiveX Data Objects 6.1 Library
    
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim constr As String
    Dim DBFile As String
    Dim i As Long
    Dim j As Long
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim rcnt As Long
    
    DBFile = ActiveWorkbook.Path & "\mydb1.accdb"
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile
    strSQL1 = "delete from テーブル4 " & _
             "where 社員ID in('E0040','H0055')"
    strSQL2 = "select * from テーブル4 where 部署C > 104 order by 社員ID"
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = constr
    cn.Open
    
    Set cmd = New ADODB.Command
    cmd.ActiveConnection = cn
    
    On Error GoTo ErrHandler
    
    'トランザクションの開始
    cn.BeginTrans
    
    With cmd
        .CommandText = strSQL1
        .Execute RecordsAffected:=rcnt
    End With
            
    '処理を確定（トランザクション終了）
    cn.CommitTrans
    
    On Error GoTo 0
                
ErrHandler:
    'エラー発生時は処理を元に戻す（トランザクション終了）
    If Err.Number <> 0 Then cn.RollbackTrans
    
    cmd.CommandText = strSQL2
    Set rs = cmd.Execute
                
    With Worksheets("Sheet1")
        .Cells.Clear
        i = 1
        .Cells.Clear
        Do Until rs.EOF
            For j = 0 To rs.Fields.Count - 1
                If i = 1 Then .Cells(i, j + 1) = rs(j).Name
                .Cells(i + 1, j + 1) = rs(j).Value
            Next j
            rs.MoveNext
            i = i + 1
        Loop
        .Columns("A:H").AutoFit
    End With
        
    Set cmd = Nothing
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

Sub Sample_Transaction1()

'参照設定:Microsoft ActiveX Data Objects 6.1 Library

Dim cn As ADODB.Connection

Dim cmd As ADODB.Command

Dim rs As ADODB.Recordset

Dim constr As String

Dim DBFile As String

Dim i As Long

Dim j As Long

Dim strSQL1 As String

Dim strSQL2 As String

Dim rcnt As Long

DBFile = ActiveWorkbook.Path & "\mydb1.accdb"

constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile

strSQL1 = "delete from テーブル4 " & _

"where 社員ID in('E0040','H0055')"

strSQL2 = "select * from テーブル4 where 部署C > 104 order by 社員ID"

Set cn = New ADODB.Connection

cn.ConnectionString = constr

cn.Open

Set cmd = New ADODB.Command

cmd.ActiveConnection = cn

On Error GoTo ErrHandler

'トランザクションの開始

cn.BeginTrans

With cmd

.CommandText = strSQL1

.Execute RecordsAffected:=rcnt

End With

'処理を確定（トランザクション終了）

cn.CommitTrans

On Error GoTo 0

ErrHandler:

'エラー発生時は処理を元に戻す（トランザクション終了）

If Err.Number <> 0 Then cn.RollbackTrans

cmd.CommandText = strSQL2

Set rs = cmd.Execute

With Worksheets("Sheet1")

.Cells.Clear

i = 1

.Cells.Clear

Do Until rs.EOF

For j = 0 To rs.Fields.Count - 1

If i = 1 Then .Cells(i, j + 1) = rs(j).Name

.Cells(i + 1, j + 1) = rs(j).Value

Next j

rs.MoveNext

i = i + 1

Loop

.Columns("A:H").AutoFit

End With

Set cmd = Nothing

Set rs = Nothing

cn.Close

Set cn = Nothing

End Sub

実行結果

サンプルVBAソースその２

　
Sub Sample_Transaction2()

    '参照設定:Microsoft ActiveX Data Objects 6.1 Library
    
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim constr As String
    Dim DBFile As String
    Dim i As Long
    Dim j As Long
    Dim strSQL As String
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim strSQL3 As String
    Dim rcnt 'RecordsAffected
    
    DBFile = ActiveWorkbook.Path & "\mydb1.accdb"
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile
    
    strSQL1 = "insert into " & _
              "テーブル4 (社員ID,氏名,フリガナ,性別,部署C,入社年月日) " & _
              "values ('E0040','田野仁','タノヒトシ','男',105,#1995/4/2#)"
    
    strSQL2 = "insert into " & _
              "テーブル4 (社員ID,氏名,フリガナ,性別,部署C,入社年月日) " & _
             "values ('H0055','国立浩司','クニタチコウジ','男',105,#1999/4/20#)"
    
    strSQL3 = "select * from テーブル4 where 部署C > 104 order by 社員ID"
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = constr
    cn.Open
    
    Set cmd = New ADODB.Command
    cmd.ActiveConnection = cn
    
    On Error GoTo ErrHandler
    
    'トランザクションの開始
    cn.BeginTrans
    
    With cmd
        
        .CommandText = strSQL1
        .Execute
        
        .CommandText = strSQL2
        .Execute
    
    End With
            
    '処理を確定（トランザクション終了）
    cn.CommitTrans
            
    On Error GoTo 0
                
ErrHandler:
    'エラー発生時は処理を元に戻す（トランザクション終了）
    If Err.Number <> 0 Then cn.RollbackTrans
    
    cmd.CommandText = strSQL3
    Set rs = cmd.Execute
    
    With Worksheets("Sheet1")
        .Cells.Clear
        i = 1
        .Cells.Clear
        Do Until rs.EOF
            For j = 0 To rs.Fields.Count - 1
                If i = 1 Then .Cells(i, j + 1) = rs(j).Name
                .Cells(i + 1, j + 1) = rs(j).Value
            Next j
            rs.MoveNext
            i = i + 1
        Loop
        .Columns("A:H").AutoFit
    End With
        
    Set cmd = Nothing
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub