INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Error Resolution

Generic Error Handler and Error Log Table by Zion7
Posted: 11 Mar 06 (Edited 1 May 06)

A rather simple routine, to log errors.

First routine, extracts all pertinant information,
  that will help, analyse and correct the error.

Then, all above data, will be appended to an "ErrorLog" table.

Then generic message will be displayed to user,
   expressing the fact, that an error has occured.
(no need for msgBox, in every error routine).

Then a general clean-up follows,
(as much as can be foreseen, without causing errors...
closing objects, that aren't open etc...)
Otherwise, more specific clean-up should be done,
in every routine.

If ErrorTable does not exist, second routine is called,
which creates the "tblErrorLog".
Then, first routine, attempts to run the append query again.

Third routine, simply creates a few errors, to show functionality, of the above mentioned, two routines.
And, how to call Generic error handler,from every procedure.
Pay heed to colored notes, at bottom.

Hope this faciltates creating an error log for others,
or at least, offers a few ideas.
Good Luck!

PS, I use "Error handler builder from Zada Solutions"
www.zada.com.au, to place a custom error handler,
in every procedure. This 3rd party utility, has the ability,
to enter each produre name as an argument,
into my ErrorLog procedure.
As of yet, I can't do this on my own.
MZ-Tools utility, adds line numbers to every procedure
in project. VERY HELPFULL, to find where error occured!!!
***When wrapper is called, from each procedure,
the arguments are different depending on whether it's
a Form Class, or Standard Module.
Examples are Below.



___________________________________________________________
Sub ErrorLog(lngNumber As Long, _
                  strDesc As String, _
                  strSource As String, _
                  strProcedure As String, _
                  Optional strForm As String, _
                  Optional intLineNumber As Integer)
On Error GoTo xxx
    
    Dim dteNow As Date, strComputer As String, strUser As String, strApp As String
    Dim strCurrentObject As String, strModule As String, strLogOn As String, strCurrentProject As String
    Dim strCurrentForm As String, strActiveControl As String, strUserName As String, objModule As Object

    'strActiveControl = Screen.ActiveControl
    'strCurrentForm = Screen.ActiveForm.Name
    strApp = CurrentProject.FullName
    dteNow = Now
    strUser = Trim$(CurrentUser())
    strCurrentObject = CurrentObjectName
    Set objModule = VBE.ActiveCodePane.CodeModule
    strModule = objModule.Name       'SORRY, not accurate...
    strComputer = Environ("COMPUTERNAME") '6
    strLogOn = replace(Environ("LOGONSERVER"), "\", "")  '14
    strUserName = Environ("UserName")
    strCurrentProject = Left(CurrentProject.Name, Len(CurrentProject.Name) - 4)

     MsgBox "Unexpected error N¦ " & lngNumber & vbCrLf & _
             vbCrLf & strDesc, vbExclamation, strCurrentProject & " - " & strProcedure
    
    CurrentProject.Connection.Execute _
        "INSERT INTO tblErrorLog(txtErrDate,txtComputer,txtLogOn,txtApplication,txtErrNumber,txtErrSource," & _
            "txtErrDescription,txtUser,txtModule,txtProcedure,txtCurrentObject, txtForm)" & _
        "VALUES(#" & dteNow & "#,'" & strComputer & "','" & strLogOn & "','" & strApp & _
        "'," & lngNumber & ",'" & strSource & "'," & Chr(34) & strDesc & Chr(34) & ",'" & strUserName & _
        "','" & strModule & "','" & strProcedure & "','" & strCurrentObject & "','" & strForm & "')"
        
xx:
    Set objModule = Nothing
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    DoCmd.Echo True
    Exit Sub
xxx:
    If Err = -2147217865 Then 'table does not exist
        Call CreateErrorTable 'Create table
        Resume                 'try again to insert, error data
    Else
        MsgBox "Unexpected error - " & Err & vbCrLf & _
        Error$, vbExclamation, strCurrentProject & " - ErrorLog"
        Resume xx
    End If
End Sub


___________________________________________________________
Sub CreateErrorTable()
On Error GoTo xxx
    Dim SQL As String
    
    SQL = "CREATE TABLE tblErrorLog (pkErrorID AUTOINCREMENT PRIMARY KEY  , " & _
                                    "txtErrDescription MEMO, " & _
                                    "txtErrNumber INTEGER, " & _
                                    "txtErrSource TEXT(50), " & _
                                    "txtCurrentObject TEXT(50), " & _
                                    "txtForm TEXT(50), " & _
                                    "txtProcedure TEXT(50), " & _
                                    "txtModule TEXT(50), " & _
                                    "txtErrDate DATETIME, " & _
                                    "txtUser TEXT(50), " & _
                                    "txtLogOn TEXT(50), " & _
                                    "txtComputer TEXT(50), " & _
                                    "txtApplication MEMO); "
                                    
    CurrentProject.Connection.Execute SQL, , 129
    
xx:
    Application.RefreshDatabaseWindow
    Exit Sub
xxx:
If Err <> -2147217900 Then 'ByPass table  already exist, error
    MsgBox Err & vbCrLf & Error$, , "CreateErrorTable"
End If
    Resume xx
End Sub


_________________________________________________________
Sub TryErrorTable()
'From Standard Module
On Error GoTo xxx

    Dim v As Integer, str As String
    
    str = Date
    
    v = 56098789 * 34
    v = 56 / 0
    Dim rec As New adodb.Recordset
    rec.Open "SELECT * FROM tblNothing", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

    CurrentDb.Execute "DELETE FROM tblNoWhere"
    
    DoCmd.OpenForm "FrmNoWhere"

xx:
    If rec.State = adStateOpen Then rec.Close
    Set rec = Nothing
    Exit Sub
xxx:
    Call ErrorLog(Err, Error$, Err.Source, "Sub; TryErrorTable",,Erl)
    DoEvents'remove, only used for example
    Resume Next 'invoke the next error'remove, only for example
Resume xx' keep this
End Sub

____________________________________________________
Private Sub cmdTotal_Click()
'Call From Form Class Module
10  On Error GoTo xxx
20       MsgBox 5/0
xx:
30      Exit Sub
xxx:
40       Call ErrorLog(Err, Error$, Err.Source, "Sub; cmdTotal_Click", Me.Name,Erl)
50       Resume xx
60   End Sub

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close