更新に必要なアクセス回数を減らす

更新に必要なアクセス回数を減らす

Sub トランザクション2()
Dim myCon As ADODB.Connection, myRS As ADODB.Recordset
Dim myFile As String, myRow As Integer, myINT As Integer

myFile = ThisWorkbook.Path & "\mdb\4-sampleDB.mdb"   'ファイルの場所
Set myCon = New ADODB.Connection
myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & myFile
Set myRS = New ADODB.Recordset
myRS.Open "注文伝票", myCon, adOpenDynamic, adLockOptimistic

myRow = 4                 '4行目から取り込み開始
On Error GoTo Trans_Err   'エラートラップ
myCon.BeginTrans          'トランザクション処理開始

Do Until Cells(myRow, 1) = ""
  myRS.AddNew
  myRS![受注コード] = Cells(myRow, 1).Value
  myRS![商品コード] = Cells(myRow, 2).Value
  myRS![商品名] = Cells(myRow, 3).Value
  myRS![単価] = Cells(myRow, 4).Value
  myRS![数量] = Cells(myRow, 5).Value
  myRS.Update       '*<---ここではまだデータベースに書き込まれない
  myRow = myRow + 1
  
  If myRow Mod 100 = 4 Then     '100件ごとにデータベースへ書き込む
    myCon.CommitTrans           '変更を反映
    myCon.BeginTrans            '再度トランザクション処理を開始する
  End If
Loop

myCon.CommitTrans     '残りの変更を書き込む (最後の数件〜数十件のデータの書き込み)

myRS.Close: Set myRS = Nothing
myCon.Close: Set myCon = Nothing

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

Exit Sub

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

End Sub

大量のデータを書き込む処理もトランザクション処理を使用すればハードディスクへのアクセス回数を減らすことができる。
上記の例では100件ずつデータを書き込んでいる。

実行結果

↓

↓

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

↓