Sub BeginTransX()

   Dim strName As String
   Dim strMessage As String
   Dim wrkDefault As Workspace
   Dim dbsNorthwind As Database
   Dim rstEmployees As Recordset

   ' Get default Workspace.
   Set wrkDefault = DBEngine.Workspaces(0)
   Set dbsNorthwind = OpenDatabase("Northwind.mdb")
   Set rstEmployees = _
      dbsNorthwind.OpenRecordset("Employees")

   ' Start of outer transaction.
   wrkDefault.BeginTrans
   ' Start of main transaction.
   wrkDefault.BeginTrans

   With rstEmployees

      ' Loop through recordset and ask user if she wants to 
      ' change the title for a specified employee.
      Do Until .EOF
         If !Title = "Sales Representative" Then
            strName = !LastName & ", " & !FirstName
            strMessage = "Employee: " & strName & vbCr & _
               "Change title to Account Executive?"

            ' Change the title for the specified employee.
            If MsgBox(strMessage, vbYesNo) = vbYes Then
               .Edit
               !Title = "Account Executive"
               .Update
            End If
         End If

         .MoveNext
      Loop

      ' Ask if the user wants to commit to all the changes 
      ' made above.
      If MsgBox("Save all changes?", vbYesNo) = vbYes Then
         wrkDefault.CommitTrans
      Else
         wrkDefault.Rollback
      End If

      ' Print current data in recordset.
      .MoveFirst
      Do While Not .EOF
         Debug.Print !LastName & ", " & !FirstName & _
            " - " & !Title
         .MoveNext
      Loop

      ' Roll back any changes made by the user since this is 
      ' a demonstration.
      wrkDefault.Rollback
      .Close
   End With

   dbsNorthwind.Close

End Sub