Access 2016 VBA 运行-时间错误-如何捕捉?

Access 2016 VBA Run-Time Errors - How to catch?

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

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

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

字段名称:

    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(注释掉)和 运行 一切时 - 我有时会在我以前的数据库版本上点击 "Run-Time Errors"(例如锁定以进行编辑) - 这被捕获了通过我的错误捕获器 - 并生成了自定义输出 - 现在,它似乎不想捕获 运行-time 错误 - 为什么不呢,出了什么问题!? (为大量阅读道歉 - 我很难准确但简短地描述事情。 - 如果需要/请求,可提供更多信息)

"New Record"的代码:

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

On Error GoTo Error_Handle 移动到第一行。

Private Sub btn_NewRecord_Click()
    On Error GoTo Error_Handle    

    ...

End Sub

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