database - 没有 AddNew 或 Edit 的更新或取消更新 - Access 错误

Question

我建立了一个偶尔会出错的数据库。

我在拆分表单/数据 TableView 中有一个装订表单。在更新记录时，我偶尔会在移动到新记录时收到“没有 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 功能。大多数人甚至不知道，如果他们在代码中添加行号(你够大，还记得 Basic 吗？)，Access 可能会在行级别陷入陷阱。

所以，像这样:

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!"