VBA/Excel/Access/Word/Access/Transaction

Rollback a transaction

 
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

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

 
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

Use transaction

 
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

Using a Database Transaction to Insert Records

 
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