4

我在提交事务时遇到问题（使用 Access 2003 DAO）。就好像我从未调用过 BeginTrans 一样——我在 CommitTrans 上收到错误 3034，“您尝试在没有先开始事务的情况下提交或回滚事务”；并将更改写入数据库（可能是因为它们从未包装在事务中）。但是，如果您单步执行 BeginTrans ，则会运行它。

  • 我使用 DBEngine(0) 工作区在 Access 环境中运行它。
  • 我要添加记录的表都是通过 Jet 数据库连接（到同一个数据库）并使用 DAO.Recordset.AddNew / Update 打开的。
  • 在启动 BeforeTrans 之前打开连接。
  • 我在事务中间没有做任何奇怪的事情，比如关闭/打开连接或多个工作区等。
  • 有两个嵌套事务级别。基本上它将多个插入包装在一个外部事务中，所以如果有任何失败，它们都会失败。内部事务运行没有错误，外部事务不起作用。

以下是我调查并排除的一些事情：

  • 事务分布在几个方法中，BeginTrans 和 CommitTrans（和 Rollback）都在不同的地方。但是当我尝试以这种方式运行事务的简单测试时，这似乎并不重要。

  • 我想当数据库连接超出本地范围时可能会关闭，即使我有另一个“全局”引用（老实说，我不确定 DAO 对 dbase 连接做了什么）。但情况似乎并非如此——就在提交之前，连接及其记录集是活动的（我可以检查它们的属性，EOF = False 等）

  • 我的 CommitTrans 和 Rollback 在事件回调中完成。（基本上：解析器程序在解析结束时抛出一个“onLoad”事件，我通过提交或回滚我在处理过程中所做的插入来处理它，这取决于是否发生了任何错误。）但是，再次尝试一个简单的测试，这似乎并不重要。

任何想法为什么这对我不起作用？

谢谢。

编辑 5 月 25 日

这是（简化的）代码。与交易有关的关键点是：

  • 工作区是 DBEngine(0)，在公共（全局）变量中引用APPSESSION。
  • 数据库连接在下面的 LoadProcess.cache 中打开，见Set db = APPSESSION.connectionTo(dbname_).
  • 在 LoadProcess.cache 中调用 BeginTrans。
  • CommitTrans 在 process__onLoad 回调中被调用。
  • 在 process__onInvalid 回调中调用回滚。
  • 记录集更新在 process__onLoadRow、logLoadInit 和 logLoad 中完成

埃里克

'------------------- 
'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
4

3 回答 3

3

通过定义一个工作区（它不必是一个新的）来使用事务，然后在该工作区上开始事务，做你需要用它做的事情，如果一切顺利，然后提交事务。骨架代码：

  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

现在，在您 [做任何事情] 的块内，您可以将工作区、数据库和记录集传递给子例程，但顶层控制结构应该保留在一个地方。

您的代码不会这样做 - 相反，您依赖于全局变量。全局变量是邪恶的。不要使用它们。相反，将私有变量作为参数传递给要对其进行操作的子例程。我还要说，永远不要传递工作区——只传递你用工作区创建的对象。

一旦你吸收了这一点，也许它会帮助你解释你的代码应该完成什么（通过阅读它我没有最模糊的想法），然后我们可以告诉你你做错了什么.

于 2010-05-26T22:39:46.530 回答
2

好的，经过多次令人沮丧的调试，我想我发现了 Jet 事务中的一个错误。毕竟，这与我的“极其复杂”的代码或“邪恶的全局变量”无关：）

看来，当以下情况成立时，您会收到错误 #3034：

  • 你打开一个快照类型的记录集
  • 在开始事务之前打开记录集
  • 在您开始事务之后，但在提交或回滚之前，记录集被关闭/取消引用。

我没有检查这是否已经知道，尽管我无法想象它不是。

当然，反正按这个顺序做事还自找麻烦，有点怪怪的，不知道为什么要这么做。我将打开/关闭快照记录集移到事务中，一切正常。

以下代码显示错误：

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

这修复了错误：

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
于 2010-05-27T05:41:38.637 回答
0

值得一提的是，这似乎比 Access 事务更广泛。我刚刚使用 Access 2007 & DAO 作为 MySQL 的前端遇到了类似的情况。使用 MySQL Autocommit=0，SQL 事务仍然会在事务的中途神秘地提交自己。

经过 2 周的挠头后，我发现了这篇文章并再次查看了我的代码。果然，MySQL 插入是由从 VBA 类模块中调用的存储过程完成的。这个类模块有一个dao.recordset打开module.initialize()和关闭的terminate()。此外，此记录集用于收集存储过程的结果。所以我有（在伪代码中......）

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

交易只是不起作用。我尝试了2周可以想象的一切。一旦我在事务中声明并关闭了 rs，一切都运行良好！

于 2011-04-01T02:51:57.777 回答