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 之间没有任何关系,您需要添加新记录的代码上方的那一行
提前致歉 - 这可能会很长 - 所有代码都添加在底部。
我正在开发一个用于跟踪支持工单的数据库。 我一直在尝试清除跟踪器弹出的错误 - 所以我开始重建 - 清理代码 - 更改字段名称等 - 这是一个全新的数据库,没有人可以访问。但出于某种原因,我的错误代码似乎不再被捕获。那么让我来解释一下吧。
前端已打开并在打开时加载登录表单 - 这利用 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 之间没有任何关系,您需要添加新记录的代码上方的那一行