トランザクション処理その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に置き換えたものである。
実行結果
↓
↓
強制的にエラーを発生させる
数値フィールドに文字列を書込強制的にエラーを発生させる
↓
