トランザクションのコミットに問題があります (Access 2003 DAO を使用)。BeginTrans を一度も呼び出していないかのように動作しています。CommitTrans でエラー 3034 が表示されます。 「最初にトランザクションを開始せずにトランザクションをコミットまたはロールバックしようとしました」。変更はデータベースに書き込まれます (おそらくトランザクションにラップされていないため)。ただし、ステップスルーすると、BeginTransが実行されます。
- DBEngine(0) ワークスペースを使用して Access 環境内で実行しています。
- レコードを追加するテーブルはすべて、(同じデータベースへの) Jet データベース接続を介して開かれ、DAO.Recordset.AddNew / Update を使用します。
- 接続は、BeforeTrans を開始する前に開かれます。
- 接続のクローズ/オープンや複数のワークスペースなど、トランザクションの途中で奇妙なことはしていません。
- ネストされたトランザクション レベルは 2 つあります。基本的に、複数の挿入を外部トランザクションにラップしているため、失敗した場合はすべて失敗します。内部トランザクションはエラーなしで実行されます。動作しないのは外部トランザクションです。
ここに私が調べて除外したいくつかのことがあります：
トランザクションはいくつかのメソッドに分散され、BeginTrans と CommitTrans (および Rollback) はすべて別の場所にあります。しかし、この方法でトランザクションを実行する簡単なテストを試みたところ、これは問題ではないようです。
別の「グローバル」参照があるにもかかわらず、データベース接続がローカルスコープから外れると、データベース接続が閉じられるのではないかと思いました（正直に言うと、DAOがdbase接続で何をするかはわかりません）。しかし、これは当てはまらないようです-コミットの直前、接続とそのレコードセットは有効です（それらのプロパティ、EOF = Falseなどを確認できます）
私の CommitTrans と Rollback は、イベント コールバック内で実行されます。(非常に基本的に: パーサー プログラムは、解析の最後に「onLoad」イベントをスローします。これは、エラーが発生したかどうかに応じて、処理中に行った挿入をコミットまたはロールバックすることで処理しています。)簡単なテストですが、これは問題ではないようです。
これがうまくいかない理由はありますか？
ありがとう。
5月25日編集
これが（簡略化された）コードです。トランザクションに関係する重要なポイントは次のとおりです。
- ワークスペースは DBEngine(0) であり、パブリック (グローバル) 変数内で参照されます
APPSESSION。 - データベース接続は、以下の LoadProcess.cache で開かれます。行を参照してください
Set db = APPSESSION.connectionTo(dbname_)。 - BeginTrans は LoadProcess.cache で呼び出されます。
- 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