Sub IncreaseQuantityTrans()
On Error GoTo IncreaseQuantityTrans_Err
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim boolInTrans As Boolean
boolInTrans = False
Set rst = New ADODB.Recordset
Set cnn = CurrentProject.Connection
rst.ActiveConnection = cnn
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
rst.Open "Select ProductID, UnitPrice From Products"
cnn.BeginTrans
boolInTrans = True
Do Until rst.EOF
rst!UnitPrice = rst!UnitPrice + 1
rst.Update
rst.MoveNext
Loop
cnn.CommitTrans
boolInTrans = False
IncreaseQuantityTrans_Exit:
Set cnn = Nothing
Set rst = Nothing
Exit Sub
IncreaseQuantityTrans_Err:
msgBox "Error # " & Err.number & ": " & Err.Description
If boolInTrans Then
cnn.RollbackTrans
End If
Resume IncreaseQuantityTrans_Exit
End Sub