我在提交事务时遇到问题(使用Access 2003 DAO)。它表现得好像我从未调用过BeginTrans - 我在CommitTrans上得到错误3034,“你试图提交或回滚事务而没有先开始一个事务”;并将更改写入数据库(可能是因为它们从未包含在事务中)。但是,如果您单步执行,则会运行BeginTrans 。
以下是我调查并排除的一些事项:
事务分布在多个方法中,BeginTrans和CommitTrans(和Rollback)都在不同的地方。但是,当我尝试以这种方式运行事务的简单测试时,似乎这不重要。
我想也许数据库连接在超出本地范围时会被关闭,即使我有另一个“全局”引用它(我也不确定DAO对dbase连接做什么是诚实的)。但似乎并非如此 - 在提交之前,连接及其记录集仍然存在(我可以检查它们的属性,EOF = False等)
我的CommitTrans和Rollback在事件回调中完成。 (非常基本上:解析器程序在解析结束时抛出'onLoad'事件,我通过提交或回滚我在处理期间插入的处理来处理,具体取决于是否发生了任何错误。)然而,再次尝试一个简单的测试,似乎不应该这么重要。
为什么这对我不起作用?
感谢。
编辑5月25日
这是(简化)代码。与交易有关的关键点是:
APPSESSION
中引用。Set db = APPSESSION.connectionTo(dbname_)
行。埃里克
'-------------------
'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
答案 0 :(得分: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
现在,在您[执行任何操作]的块中,您可以将工作空间和数据库以及记录集传递给子例程,但顶层控制结构应保留在一个位置。
您的代码不会这样做 - 相反,您依赖于全局变量。全球变量都是邪恶的。不要使用它们。而是将私有变量作为参数传递给要对其进行操作的子例程。我还要说,永远不要通过工作区 - 只传递你用工作区创建的对象。
一旦你吸收了它,也许它会帮助你解释你的代码应该完成什么(我从阅读它没有最模糊的想法),然后我们可以告诉你你的代码是什么做错了。
答案 1 :(得分: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
答案 2 :(得分: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
并且交易无效。我尝试了两周所能想到的一切。 一旦我在交易中声明并关闭了rs,一切都运行得很好!