MS Access (Jet) transactions, workspaces

问题

I am having trouble with committing a transaction (using Access 2003 DAO). It's acting as if I never had called BeginTrans -- I get error 3034 on CommitTrans, "You tried to commit or rollback a transaction without first beginning a transaction"; and the changes are written to the database (presumably because they were never wrapped in a transaction). However, BeginTrans is run, if you step through it.

I am running it within the Access environment using the DBEngine(0) workspace.
The tables I'm adding records to are all opened via a Jet database connection (to the same database) and using DAO.Recordset.AddNew / Update.
The connection is opened before starting BeforeTrans.
I'm not doing anything weird in the middle of the transaction like closing/opening connections or multiple workspaces etc.
There are two nested transaction levels. Basically it's wrapping multiple inserts in an outer transaction, so if any fail they all fail. The inner transactions run without errors, it's the outer transaction that doesn't work.

Here are a few things I've looked into and ruled out:

The transaction is spread across several methods and BeginTrans and CommitTrans (and Rollback) are all in different places. But when I tried a simple test of running a transaction this way, it doesn't seem like this should matter.
I thought maybe the database connection gets closed when it goes out of local scope, even though I have another 'global' reference to it (I'm never sure what DAO does with dbase connections to be honest). But this seems not to be the case -- right before the commit, the connection and its recordsets are alive (I can check their properties, EOF = False, etc.)
My CommitTrans and Rollback are done within event callbacks. (Very basically: a parser program is throwing an 'onLoad' event at the end of parsing, which I am handling by either committing or rolling back the inserts I made during processing, depending on if any errors occurred.) However, again, trying a simple test, it doesn't seem like this should matter.

Any ideas why this isn't working for me?

Thanks.

EDIT 25 May

Here is the (simplified) code. The key points having to do with the transaction are:

The workspace is DBEngine(0), referenced within the public (global) variable APPSESSION.
The database connection is opened in LoadProcess.cache below, see the line Set db = APPSESSION.connectionTo(dbname_).
BeginTrans is called in LoadProcess.cache.
CommitTrans is called in the process__onLoad callback.
Rollback is called in the process__onInvalid callback.
Recordset updates are done in process__onLoadRow, logLoadInit, and logLoad

Eric

'------------------- 
'Application globals
'-------------------

Public APPSESSION As DAOSession

'------------------
' Class LoadProcess
'------------------

Private WithEvents process_ As EventedParser
Private errs_ As New Collection

Private dbname_ As String
Private rawtable_ As String
Private logtable_ As String
Private isInTrans_ As Integer

Private raw_ As DAO.Recordset
Private log_ As DAO.Recordset
Private logid_ As Variant

Public Sub run
    '--- pre-load
    cache
    resetOnRun    ' resets load state variables per run, omitted here
    logLoadInit
    Set process_ = New EventedParser

    '--- load
    process_.Load
End Sub

' raised once per load() if any row invalid
Public Sub process__onInvalid(filename As String)
    If isInTrans_ Then APPSESSION.Workspace.Rollback
End Sub

' raised once per load() if all rows valid, after load
Public Sub process__onLoad(filename As String)
    If errs_.Count > 0 Then
        logLoadFail filename, errs_
    Else
        logLoadOK filename
    End If

    If isInTrans_ Then APPSESSION.Workspace.CommitTrans
End Sub

' raised once per valid row
' append data to raw_ recordset
Public Sub process__onLoadRow(row As Dictionary)
On Error GoTo Err_

    If raw_ Is Nothing Then GoTo Exit_   
    DAOext.appendFromHash raw_, row, , APPSESSION.Workspace

Exit_:
    Exit Sub

Err_:
    ' runtime error handling done here, code omitted
    Resume Exit_

End Sub


Private Sub cache()
Dim db As DAO.Database

    ' TODO raise error
    If Len(dbname_) = 0 Then GoTo Exit_       
    Set db = APPSESSION.connectionTo(dbname_)
    ' TODO raise error
    If db Is Nothing Then GoTo Exit_ 

    Set raw_ = db.OpenRecordset(rawtable_), dbOpenDynaset)
    Set log_ = db.OpenRecordset(logtable_), dbOpenDynaset)    

    APPSESSION.Workspace.BeginTrans
    isInTrans_ = True

Exit_:
    Set db = Nothing

End Sub

' Append initial record to log table
Private Sub logLoadInit()
Dim info As New Dictionary
On Error GoTo Err_

    ' TODO raise error?
    If log_ Is Nothing Then GoTo Exit_   

    With info
        .add "loadTime", Now
        .add "loadBy", CurrentUser
    End With

    logid_ = DAOext.appendFromHash(log_, info, , APPSESSION.Workspace)

Exit_:
    Exit Sub

Err_:
    ' runtime error handling done here, code omitted
    Resume Exit_

End Sub

Private Sub logLoadOK(filename As String)
    logLoad logid_, True, filename, New Collection
End Sub

Private Sub logLoadFail(filename As String, _
                      errs As Collection)
    logLoad logid_, False, filename, errs
End Sub

' Update log table record added in logLoadInit
Private Sub logLoad(logID As Variant, _
                    isloaded As Boolean, _
                    filename As String, _
                    errs As Collection)

Dim info As New Dictionary
Dim er As Variant, strErrs As String
Dim ks As Variant, k As Variant
On Error GoTo Err_

    ' TODO raise error?
    If log_ Is Nothing Then GoTo Exit_   
    If IsNull(logID) Then GoTo Exit_

    For Each er In errs
        strErrs = strErrs & IIf(Len(strErrs) = 0, "", vbCrLf) & CStr(er)
    Next Er

    With info
        .add "loadTime", Now
        .add "loadBy", CurrentUser
        .add "loadRecs", nrecs
        .add "loadSuccess", isloaded
        .add "loadErrs", strErrs
        .add "origPath", filename
    End With

    log_.Requery
    log_.FindFirst "[logID]=" & Nz(logID)
    If log_.NoMatch Then
        'TODO raise error
    Else
        log_.Edit
        ks = info.Keys
        For Each k In ks
            log_.Fields(k).Value = info(k)
        Next k
        log_.Update
    End If

Exit_:
    Exit Sub

Err_:
    ' runtime error handling done here, code omitted
    Resume Exit_

End Sub


'-------------
' Class DAOExt
'-------------
' append to recordset from Dictionary, return autonumber id of new record
Public Function appendFromHash(rst As DAO.Recordset, _
                          rec As Dictionary, _
                          Optional map As Dictionary, _
                          Optional wrk As DAO.workspace) As Long
Dim flds() As Variant, vals() As Variant, ifld As Long, k As Variant
Dim f As DAO.Field, rst_id As DAO.Recordset
Dim isInTrans As Boolean, isPersistWrk As Boolean
On Error GoTo Err_

    ' set up map (code omitted here)

    For Each k In rec.Keys
        If Not map.Exists(CStr(k)) Then _
            Err.Raise 3265, "appendFromHash", "No field mapping found for [" & CStr(k) & "]"
        flds(ifld) = map(CStr(k))
        vals(ifld) = rec(CStr(k))
        ifld = ifld + 1
    Next k

    If wrk Is Nothing Then
        isPersistWrk = False
        Set wrk = DBEngine(0)
    End If

    wrk.BeginTrans
        isInTrans = True
        rst.AddNew
        With rst
            For ifld = 0 To UBound(flds)
                .Fields(flds(ifld)).Value = vals(ifld)
            Next ifld
        End With
        rst.Update

        Set rst_id = wrk(0).OpenRecordset("SELECT @@Identity", DAO.dbOpenForwardOnly, DAO.dbReadOnly)
        appendFromHash = rst_id.Fields(0).Value

    wrk.CommitTrans
    isInTrans = False

Exit_:
    On Error GoTo 0
    If isInTrans And Not wrk Is Nothing Then wrk.Rollback
    If Not isPersistWrk Then Set wrk = Nothing
    Exit Function

Err_:
    ' runtime error handling, code omitted here
    Resume Exit_

End Function


'-----------------
' Class DAOSession (the part that deals with the workspace and dbase connections)
'-----------------
Private wrk_ As DAO.workspace
Private connects_ As New Dictionary
Private dbs_ As New Dictionary

Public Property Get workspace() As DAO.workspace
    If wrk_ Is Nothing Then
        If DBEngine.Workspaces.Count > 0 Then
            Set wrk_ = DBEngine(0)
        End If
    End If
    Set workspace = wrk_
End Property

Public Property Get connectionTo(dbname As String) As DAO.database
    connectTo dbname
    Set connectionTo = connects_(dbname)
End Property

Public Sub connectTo(dbname As String)
Dim Cancel As Integer
Dim cnn As DAO.database
Dim opts As Dictionary
    Cancel = False

    ' if already connected, use cached reference
    If connects_.Exists(dbname) Then GoTo Exit_

    If wrk_ Is Nothing Then _
        Set wrk_ = DBEngine(0)

    ' note opts is a dictionary of connection options, code omitted here
    Set cnn = wrk_.OpenDatabase(dbs_(dbname), _
                                CInt(opts("DAO.OPTIONS")), _
                                CBool(opts("DAO.READONLY")), _
                                CStr(opts("DAO.CONNECT")))

    ' Cache reference to dbase connection
    connects_.Add dbname, cnn

Exit_:
    Set cnn = Nothing
    Exit Sub

End Sub

回答1:

Transactions are used by defining a workspace (it doesn't have to be a new one) and then beginning the transaction on that workspace, doing what you need to do with it, and then commiting the transaction if all is well. Skeletal code:

  On Error GoTo errHandler
    Dim wrk As DAO.Workspace

    Set wrk = DBEngine(0) ' use default workspace
    wrk.BeginTrans
    [do whatever]
    If [conditions are met] Then
       wrk.CommitTrans
    Else
       wrk.Rollback
    End If

  errHandler:
    Set wrk = Nothing

  exitRoutine:
    ' do whatever you're going to do with errors
    wrk.Rollback
    Resume errHandler

Now, within the block where you [do whatever], you can pass off the workspace and databases and recordsets to subroutines, but the top-level control structure should remain in one place.

Your code does not do that -- instead, you depend on global variables. GLOBAL VARIABLES ARE EVIL. Don't use them. Instead, pass private variables as parameters to the subroutines you want to operate on them. I would also say, never pass the workspace -- only pass the objects you've created with the workspace.

Once you've absorbed that, maybe it will help you explain what your code is supposed to accomplish (which I haven't the foggiest idea of from reading through it), and then we can advise you as to what you're doing wrong.

回答2:

OK, after much frustrating debugging, I think I uncovered a bug in Jet transactions. After all that, it has nothing to do with my "enormously convoluted" code or "evil global variables" :)

It appears that when the following is true, you get the error #3034:

You open a snapshot-type recordset
The recordset is opened before you start the transaction
The recordset is closed/dereferenced after you begin the transaction, but before the commit or rollback.

I haven't checked if this is already known, although I can't imagine it isn't.

Of course, it's kind of weird to do things in this order anyway and asking for trouble, I don't know why I did it. I moved opening/closing the snapshot recordset to within the transaction and everything works fine.

The following code exhibits the error:

Public Sub run()
Dim db As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
Dim wrk As DAO.Workspace, isInTrans As Boolean
On Error GoTo Err_

    Set wrk = DBEngine(0)
    Set db = wrk(0)
    Set rst = db.OpenRecordset("Table2", DAO.dbOpenSnapshot)

    wrk.BeginTrans
    isInTrans = True

    Set qdf = db.CreateQueryDef("", "INSERT INTO [Table1] (Field1, Field2) VALUES (""Blow"", ""Laugh"");")
    qdf.Execute dbFailOnError

Exit_:
    Set rst = Nothing
    Set qdf = Nothing
    Set db = Nothing
    If isInTrans Then wrk.CommitTrans
    isInTrans = False
    Exit Sub

Err_:
    MsgBox Err.Description
    If isInTrans Then wrk.Rollback
    isInTrans = False
    Resume Exit_

End Sub

And this fixes the error:

Public Sub run()
Dim db As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
Dim wrk As DAO.Workspace, isInTrans As Boolean
On Error GoTo Err_

    Set wrk = DBEngine(0)
    Set db = wrk(0)

    wrk.BeginTrans
    isInTrans = True

    ' NOTE THIS LINE MOVED WITHIN THE TRANSACTION
    Set rst = db.OpenRecordset("Table2", DAO.dbOpenSnapshot)

    Set qdf = db.CreateQueryDef("", "INSERT INTO [Table1] (Field1, Field2) VALUES (""Blow"", ""Laugh"");")
    qdf.Execute dbFailOnError

Exit_:
    Set rst = Nothing
    Set qdf = Nothing
    Set db = Nothing
    If isInTrans Then wrk.CommitTrans
    isInTrans = False
    Exit Sub

Err_:
    MsgBox Err.Description
    If isInTrans Then wrk.Rollback
    isInTrans = False
    Resume Exit_

End Sub

回答3:

For what it is worth this seems to be a bit more widespread than just Access transactions. I have just encountered a similar situation using Access 2007 & DAO as a front end to MySQL. With MySQL Autocommit=0, The SQL transactions would nonetheless mysteriously commit themselves half way through a transaction.

After 2 weeks of head scratching I came across this post and looked at my code again. Sure enough, the MySQL inserts were being done by a Stored procedure that was called from within a VBA class module. This class module had a dao.recordset that was opened on module.initialize() and closed on terminate(). Furthermore, this recordset was used to collect the results of the stored procedure. So I had (in pseudo code...)

module.initialize - rs.open

class properties set by external functions

transaction.begins

Mysql procedure.calls using class properties as parameters - 

commit(or rollback)

rs.populate

class properties.set

properties used by external functions

module terminate - rs.close

and the transactions were just not working. I tried everything imaginable for 2 weeks. Once I declared and closed the rs within the transaction everything worked perfectly!

来源：https://stackoverflow.com/questions/2901408/ms-access-jet-transactions-workspaces

标签

ms-access

transactions

workspace