トランザクション処理を行う

トランザクション処理その2

Sub トランザクション2_SQL()
Dim myCon As New ADODB.Connection
Dim myFile As String, myRow As Integer, myINT As Integer
Dim mySQL As String, Data(4) As Variant

myFile = ThisWorkbook.Path & "\mdb\4-sampleDB.mdb"   'ファイルの場所
myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & myFile

myRow = 4                 '4行目から取り込み開始
On Error GoTo Trans_Err   'エラートラップ

myCon.Execute "BEGIN TRANSACTION"   '<--*トランザクション処理スタート

Do Until Cells(myRow, 1) = ""
  Data(0) = Cells(myRow, 1).Value
  Data(1) = Cells(myRow, 2).Value
  Data(2) = "'" & Cells(myRow, 3).Value & "'" 'このデータのみ文字列
  Data(3) = Cells(myRow, 4).Value
  Data(4) = Cells(myRow, 5).Value
  
  '「注文伝票」テーブルにデータを追加するSQL文
  mySQL = "insert into 注文伝票 values(" & Data(0) & "," & Data(1) & "," & _
          Data(2) & "," & Data(3) & "," & Data(4) & ");"
          
  myCon.Execute mySQL                     '*<---SQLを実行する
  myRow = myRow + 1                       'ここではまだデータベースに書き込まれない
  
  If myRow Mod 100 = 4 Then               '<--100件ごとにデータベースへ書き込む
    myCon.Execute "COMMIT TRANSACTION"    '<--ここで変更をまとめて書き込む
    myCon.Execute "BEGIN TRANSACTION"     '<--*再度トランザクション処理を開始する
  End If
Loop

myCon.Execute "COMMIT TRANSACTION"        '残りの変更を書き込む
                                          '(最後の数件〜数十件のデータの書き込み)
myCon.Close: Set myCon = Nothing

'終了メッセージ
MsgBox myRow - 4 & " 件のデータを書き込みました。", vbOKOnly, "処理完了！"

Exit Sub

Trans_Err:    'エラー時の処理
  myINT = Int((myRow - 4) / 100) * 100
  MsgBox "現在 " & myINT & " 番目のレコードまで書き込んでいます。", vbOKOnly, _
          myRow & "行目でエラー発生！"
  '変更を破棄し、トランザクション処理前の状態に戻す
  myCon.Execute "ROLLBACK TRANSACTION"
  myCon.Close: Set myCon = Nothing

End Sub

上記はこちらのサンプルをSQLに置き換えたものである。

実行結果

↓

↓

強制的にエラーを発生させる
数値フィールドに文字列を書込強制的にエラーを発生させる

↓