VBA/Excel/Access/Word/Access/Transaction

Rollback a transaction

   <source lang="vb">

Sub exaCreateAction2()

   Dim ws As Workspace
   Dim db As Database
   Dim qdf As QueryDef
   Dim strSQL As String
   
   Set ws = DBEngine(0)
   Set db = CurrentDb
   
   strSQL = "UPDATE BOOKS SET Price = Price*1.1 WHERE Price > 20"
   
   Set qdf = db.CreateQueryDef("PriceInc", strSQL)
   ws.BeginTrans
   qdf.Execute
   If qdf.RecordsAffected > 15 Then
       Debug.Print qdf.RecordsAffected 
       ws.Rollback
   Else
       Debug.Print qdf.RecordsAffected
       ws.rumitTrans
   End If

End Sub

</source>
   
  

Transaction Processing in Access sing BeginTrans, Logging, CommitTrans, and RollbackTrans

   <source lang="vb">

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.rumitTrans
   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

</source>
   
  

Use transaction

   <source lang="vb">

Sub TestTransaction()

   Dim cnConnection As New ADODB.Connection
   Dim cmdCommand As New ADODB.rumand
   Set cnConnection = CurrentProject.Connection
   cmdCommand.ActiveConnection = cnConnection
   
   On Error GoTo HandleError
   cnConnection.BeginTrans
   cmdCommand.rumandText = "UPDATE tblContacts SET FirstName = "Test" WHERE ContactId = 1"
   cmdCommand.Execute
   cmdCommand.rumandText = "UPDATE tblContacts SET ContactId = "A" WHERE ContactId = 1"
   cmdCommand.Execute
   cnConnection.rumitTrans
   Exit Sub
   HandleError:
       cnConnection.RollbackTrans
       MsgBox "An error occurred: " & Err.Description

End Sub

</source>
   
  

Using a Database Transaction to Insert Records

   <source lang="vb">

Sub Create_Transaction()

   Dim conn As ADODB.Connection
   On Error GoTo ErrorHandler
   Set conn = New ADODB.Connection
   With conn
       .Provider = "Microsoft.Jet.OLEDB.4.0"
       .ConnectionString = "Data Source = " & CurrentProject.Path & "\mydb.mdb"
       .Open
       .BeginTrans
          .Execute "INSERT INTO Customers Values("A","P","M", "Manager", "M 10","W", Null, "02-111", "Vancouver", "0000000000000", Null)"
          .Execute "INSERT INTO Orders (CustomerId, EmployeeId, OrderDate, RequiredDate) Values ("G", 1, Date(), Date()+5)"
        .rumitTrans
        .Close
        Debug.Print "Both inserts completed."
    End With

ExitHere:

    Set conn = Nothing
    Exit Sub

ErrorHandler:

    If Err.Number = -2147467259 Then
       MsgBox Err.Description
       Resume ExitHere
    Else
        MsgBox Err.Description
        With conn
            .RollbackTrans
            .Close
        End With
        Resume ExitHere
    End If

End Sub

</source>