Better error info when query fails in VBA behind a form or report 1

[N2Life]

When a query fails in a program, the error info Access gives is not enough. I have to ask the user questions to zero in on what form or report was in use and what was being done when the failure happened, before I even know which query we are talking about. Below is my attempt to deal with this. I have not had an opportunity to test this on a machine with only run-time Access. I would be grateful for your comments on how I am going about this. Thank you.

Put these functions into a module:

Public Function Run_SQL(strsql As String) As Boolean
'---------------------------------------------------------------------------
On Error GoTo SQLDidNotRun
DoCmd.SetWarnings False
DoCmd.RunSQL strsql
DoCmd.SetWarnings True
Run_SQL = True

EXIT_PROC:
Exit Function

SQLDidNotRun:
DoCmd.SetWarnings True
Run_SQL = False
GoTo EXIT_PROC
End Function

Public Function Open_Qry(qryName As String) As Boolean
'---------------------------------------------------------------------------
On Error GoTo QryDidNotRun
DoCmd.SetWarnings False
DoCmd.OpenQuery qryName
DoCmd.SetWarnings True
Open_Qry = True

EXIT_PROC:
Exit Function

QryDidNotRun:
DoCmd.SetWarnings True
Open_Qry = False
GoTo EXIT_PROC
End Function

 
Example of use:
At the beginning of the code for the particular event, such as Form_Load for a form named frmOpening, add, for example:

Const CalledFrom = "frmOpening" ' Name of form or report.
Const ForEvent = "Form_Load" ' Name of event.
Dim strsql As String ' For in-line queries.
Dim tgtqry As String ' For existing queries.
Dim ErrTxt As String

Here is an example of running an in-line query. (The first table mentioned is deliberately non-existent.)
'---------------------------------------------------------------------------
strsql = "INSERT INTO tblInboundHistoryXXX SELECT tblInbound.* FROM " & _ "tblInbound WHERE LeftUSA<(Date()-2)"
If Run_SQL(strsql) = False Then
GoSub ERROR_MSG_SQL
End If
'---------------------------------------------------------------------------

Here is an example of running an existing query:
'---------------------------------------------------------------------------
tgtqry = "qryDeleteArchived_tblOther"
If Open_Qry(tgtqry) = False Then
GoSub ERROR_MSG_QRY
End If
'---------------------------------------------------------------------------

After all other code has been entered for this event, insert the remaining lines shown here:
EXIT_PROC:
Exit Sub

ERROR_MSG_SQL:
ErrTxt = "An error occurred during an attempt to run this in-line query:" & vbCrLf & vbCrLf & strsql
GoSub GatherFacts
ShowMsg ErrTxt, "ERROR", "Courier New", 12
GoTo EXIT_PROC

ERROR_MSG_QRY:
ErrTxt = "An error occurred during an attempt to run the query:" & vbCrLf & vbCrLf & tgtqry
GoSub GatherFacts
ShowMsg ErrTxt, "ERROR", "Courier New", 12
GoTo EXIT_PROC

GatherFacts:
ErrTxt = ErrTxt & vbCrLf & vbCrLf & _
"From: " & CalledFrom & vbCrLf & _
"Event: " & ForEvent & vbCrLf & vbCrLf & _
"Computer: " & fOSMachineName & vbCrLf & _
"User: " & fOSUserName & vbCrLf & vbCrLf & _
"Date: " & Format(Date, "ddd, mmm d, yyyy") & vbCrLf & _
"Time: " & Format(Time, "h:nn AM/PM") & vbCrLf & vbCrLf & _
"Please notify IT."
Return

End Sub

Source for fosMachineName and fosUserName:

http://www.databasedev.co.uk/get_username_or_computername.html

(Dev Ashish)

Example of output for in-line query.
An error occurred during an attempt to run this in-line query:
INSERT INTO tblInboundHistoryXXX SELECT tblInbound.* FROM tblInbound WHERE LeftUSA<(Date()-2)
From: frmOpening
Event: Form_Load
Computer: DON_THINK
User: Don
Date: Fri, Dec 28, 2018
Time: 2:24 PM
Please notify IT.

Example of output for an existing query.
An error occurred during an attempt to run the query:
qryDeleteArchived_tblOther

From: frmOpening
Event: Form_Load
Computer: DON-THINK
User: Don
Date: Fri, Dec 28, 2018
Time: 3:12 PM
Please notify IT.

 

[Andrzejek]

Does your [tt]ShowMsg[/tt] just show the message box to the users? And instruct them to "Please notify IT."?

I would pass more attributes to my [tt]Run_SQL[/tt] function and deal with the error in there.
And instead on relying on users to tell me what happened, I would write this info into a simple text file on the server and monitor this file regularly.

strsql = "INSERT INTO tblInboundHistoryXXX SELECT tblInbound.* " & _ 
         " FROM tblInbound WHERE LeftUSA < (Date()-2)"
If Run_SQL(strsql[blue], Me.Name, "Form_Load"[/blue]) Then
    .... [green]'Do what needs to be done when all is OK[/green]
End If

Public Function Run_SQL(ByRef strsql As String, _[blue]
    ByRef strCalledFrom As String, ByRef strForEvent As String[/blue]) As Boolean
 '---------------------------------------------------------------------------
 On Error GoTo SQLDidNotRun
 DoCmd.SetWarnings False
 DoCmd.RunSQL strsql
 DoCmd.SetWarnings True
 Run_SQL = True

 EXIT_PROC:
 Exit Function

 SQLDidNotRun:
 DoCmd.SetWarnings True
 Run_SQL = False
[blue]
Open "\\server\folder\ErrorLog.txt" For Append As #1
Print #1, Now() & vbCrLf & _
"From: " & strCalledFrom & vbCrLf & _
"Event: " & strForEvent & vbCrLf & _
"Computer: " & fOSMachineName & vbCrLf & _
"User: " & fOSUserName & vbCrLf & _
"Error: " & Err.Number & ", " & Err.Description & vbCrLf & _
"SQL: " & strsql & vbCrLf & _
"================================"
Close #1

MsgBox "Hey, the error happened."
[/blue]

 GoTo EXIT_PROC
 End Function

You may also get fancy and e-mail yourself this information when the error happens....

Just a suggestion...

---- Andy

There is a great need for a sarcasm font.

 

[N2Life]

Yes, ShowMsg is a subroutine that gives me more control over how a message looks.

I have adopted the improvements you suggested, including the email idea. Thank you for the clear, well-organized info.