Access 2016 VBA 运行时错误 - 如何捕获？

Question

提前致歉 - 这可能会很长 - 所有代码都添加在底部。

我正在开发一个用于跟踪支持票证的数据库。 我一直在尝试清除跟踪器出现的错误 - 所以我开始重建 - 清理代码 - 更改字段名称等 - 这是一个全新的数据库，没有人可以访问。但由于某种原因，我的错误代码似乎不再捕获。所以让我解释一切。

前端打开并打开，加载登录表单 - 这利用 DLOOKUP 来检查和匹配密码 - 这很好 登录后，会加载票务输入表单 (Frm_ticket_Entry)，其中包含多个数据字段和 2 个按钮。 （我只列出一些，因为实际上没有一个是强制性的）

字段名称：

    Ticket_Number - (fairly self explanatory)
    Agent         - (Agent working ticket)
    Return_Team   - (if ticket was returned)

按钮：

    New Record - (Adds a new record - Guess you can tell that)
    Save Record - (saves record after data changes)

当使用 Err.raise("error number") - 我的捕手按预期工作

当我关闭 err.raise （注释掉）并运行所有内容时 - 我有时会在我以前的数据库版本上点击“运行时错误”（例如锁定编辑） - 这被我的错误捕获器捕获 - 并产生自定义输出 - 现在，它似乎不想捕捉运行时错误 - 为什么不呢，出了什么问题！？ （为广泛阅读道歉 - 我很难准确地描述事物，但简短。 - 如果需要/要求提供更多信息）

“新记录”代码：

Private Sub btn_NewRecord_Click()
    DoCmd.GoToRecord , , acNewRec 'Add a new record
    Me.Ticket_Number = "#" ' Change ticket number textbox to "#"
    Me.Kickback_Reason = "Pass to next level support" ' - Set Default entry for kick back reason
    Me.Agent = User() ' Set "Agent" field to the currently logged in user
    Me.Returning_Team = "CSC Service Desk" ' Set default for "Returning Team"
    DoCmd.RunCommand acCmdSaveRecord 'Save the record into the table
    DoCmd.GoToRecord acDataTable = tbl_Tickets, , acLast ' return to the last saved record

On Error GoTo Error_Handle    
'    Err.Raise 3314, "btn_New_Record_Click()", "Errored" ' Force error for debug purposes
'    Err.Raise 2105, "btn_New_Record_Click()", "Errored"
'    Err.Raise 21345, , "Unknown Error Occured"
Exit Sub

Error_Handle:

Call ErrorLogger(Err.Number, Err.Description, Err.Source)    
  Err.Clear
  MsgBox "Error Trapping complete"    
  Resume Next    
  End Sub

ErrorLogger 的代码：

    Function ErrorLogger(ErrNum As Integer, ErrDesc, ErrSrc As String)

Select Case ErrNum

Case 3314 ' You must enter a value in the 'tblKickbacks.Ticket Number' field.
MsgBox "It seems some required fields may not have been completed! " _
& "Please ensure you have filled in 'Ticket Number' / 'Agent' /     'Returning Team' and/or 'Kickback Reason'"

If IsNull(Me.Ticket_Number) Then
Me.Ticket_Number.SetFocus
End If

If (MsgBox("Error " & ErrNum & " occured." & vbNewLine _
& "Details : " & ErrDesc & vbNewLine _
& "Error occured in : " & ErrSrc & vbNewLine _
& "Would you like to send an email error report?" _
, 4 Or 16, "ERROR DETECTED")) = vbYes _
Then
    GoTo DevEmail
Else
    GoTo Err_Exit
End If

Case 2105 ' You can't go to the specified record.

MsgBox "Error Caught - 2105"

Case 3218 ' Error Description: Could not update; currently locked.

'   Need to find and add code here for forcibly unlocking any and ALL locked records

Case Else
MsgBox "Error : " & ErrNum & " -- " & ErrDesc & " " _
& "Not recognised - Sending error email"
GoTo DevEmail

End Select

DevEmail:

Dim oAPP As Outlook.Application
Dim oMail As Outlook.MailItem

' Create the Outlook session.
Set oAPP = New Outlook.Application

' Create the message.
Set oMail = oAPP.CreateItem(olMailItem)

With oMail
    ' Add the To recipient(s) to the message.
    .To = "mwalker53@csc.com"
    .Subject = "Tracker V2 Error"
    .Body = "Error message as Follows:" & vbNewLine _
                    & "Error Number: " & ErrNum & vbNewLine _
                    & "Error Description: " & ErrDesc & vbNewLine _
                    & "Error Source: " & ErrSrc
    .Send
End With
MsgBox "Email has been sent"

Err_Exit:        
End Function

Answer 1

在第一行移动On Error GoTo Error_Handle。

Private Sub btn_NewRecord_Click()
    On Error GoTo Error_Handle    

    ...

End Sub

Answer 2

在 on error goto errhandle 和 exit sub 之间没有任何内容，您需要在添加新记录的代码上方的那一行