Question

我已经构建了一个数据库，偶尔会出现错误。

我在拆分表单/数据表视图中有一个绑定表单。有时，在更新记录时，我会在移动到新记录时收到“Update或CancelUpdate without AddNew或Edit”错误。这将在单个记录表单或数据表中发生。

每次保存记录时都不会发生这种情况。可能是20或30次中的1次。

我确实内置了AuditTrail，这是我唯一可能导致问题的猜测。

表格上的VBA：

Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("ApptID", "DELETED PRIOR RECORD")
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord Then
    Call AuditChanges("ApptID", "NEW")
Else
    Call AuditChanges("ApptID", "EDIT")
End If
End Sub

Private Sub Form_Delete(Cancel As Integer)
If Status = acDeleteOK Then Call AuditChanges("ApptID", "DELETE BUTTON HIT")
End Sub

AuditTrail代码是：

Sub AuditChanges(IDField As String, UserAction As String)
On Error GoTo AuditChanges_Err
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim ctl As Control
Dim datTimeCheck As Date
Dim strUserID As String
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM AuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
 strUserID = Environ("USERNAME")
Select Case UserAction
    Case "EDIT"
        For Each ctl In Screen.ActiveControl.Parent.Controls
            If ctl.Tag = "Audit" Then
                If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                    With rst
                        .AddNew
                        ![DateTime] = datTimeCheck
                        ![UserName] = strUserID
                        ![FormName] = Screen.ActiveControl.Parent.Name
                        ![Action] = UserAction
                        ![RecordID] = Screen.ActiveControl.Parent.Controls(IDField).Value
                        ![FieldName] = ctl.ControlSource
                        ![OldValue] = ctl.OldValue
                        ![NewValue] = ctl.Value
                        .Update
                    End With
                End If
            End If
        Next ctl
    Case Else
        With rst
            .AddNew
            ![DateTime] = datTimeCheck
            ![UserName] = strUserID
            ![FormName] = Screen.ActiveControl.Parent.Name
            ![Action] = UserAction
            ![RecordID] = Screen.ActiveControl.Parent.Controls(IDField).Value
            .Update
        End With
End Select
AuditChanges_Exit:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
Resume AuditChanges_Exit
End Sub

如果错误不涉及VBA代码，我不知道问题可能是什么。

Answer 1

我同意dbmitch;在您的错误消息中添加一些额外的信息将是一个很大的帮助。

此外，如果这并不能满足您的需求，您还可以实现鲜为人知的ERL功能。大多数人甚至不知道Access可以在行级别陷阱，如果他们在他们的代码中添加行号（你的年龄足以记住Basic吗？）。

所以，比如：

Sub AuditChanges(IDField As String, UserAction As String)
10  On Error GoTo AuditChanges_Err

20  Dim cnn As ADODB.Connection
30  Dim rst As ADODB.Recordset
40  Dim ctl As Control
50  Dim datTimeCheck As Date
60  Dim strUserID As String

70  Set cnn = CurrentProject.Connection
80  Set rst = New ADODB.Recordset
etc...

然后您可以将错误处理程序更改为：

400  MsgBox "UserAction: " & UserAction & vbCrLf & _
        "IDField: " & IDField & vbCrLf & _
        "Error Line: " & Erl & vbCrLf & _
        "Error: (" & Err.Number & ") " & Err.Description, vbCritical, "ERROR!"

Answer 2

事实证明，问题似乎与AuditTrail代码没有任何问题。

有一个组合框在转移到新记录时偶尔会被挂起。

我将以下代码添加到该字段的“退出”事件中，我从未看到过该错误。

    If Me.Dirty Then
        Me. Dirty = False
    End If

更新或取消更新没有AddNew或编辑 - 访问错误

2 个答案: