Error Handler best practices

I use this convention frequently:

Exit_Here:
Exit Sub
HandleErr:
Select Case Err.Number
Case 3163
Resume Next
Case 3376
Resume Next
Case Else
MsgBox "Error Number " & Err.Number & ": " & Err.Description
Resume Exit_Here
End Select

Is there a way to include the current procedure name on Case Else?

perhaps something like this:

Case Else
MsgBox "Error Number " & Err.Number & ": " & Err.Description &
vbCrLf & _
Me.ProcedureName & Me.Form
Resume Exit_Here
End Select
(note: "Me.ProcedureName" is pseudo code - I don't know if it's possible to
get this...)

How about offloading this to a module so I don't have to type it out every
time:

Case Else
strP = Me!Procedure
strF = Me.Form
modErr.caseElse
End Select

thoughts ? suggestions ?

Thanks in advance...

re: Error Handler best practices

RE/[color=blue]
>I use this convention frequently:
>
>Exit_Here:
> Exit Sub
>HandleErr:
> Select Case Err.Number
> Case 3163
> Resume Next
> Case 3376
> Resume Next
> Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description
> Resume Exit_Here
> End Select
>
>Is there a way to include the current procedure name on Case Else?
>
>perhaps something like this:
>
>Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description &
>vbCrLf & _
> Me.ProcedureName & Me.Form
> Resume Exit_Here
>End Select
>(note: "Me.ProcedureName" is pseudo code - I don't know if it's possible to
>get this...)
>
>How about offloading this to a module so I don't have to type it out every
>time:
>
>Case Else
> strP = Me!Procedure
> strF = Me.Form
> modErr.caseElse
>End Select
>
>thoughts ? suggestions ?
>
>Thanks in advance...
>[/color]

Every routine I write is within the skeleton below.

"DebugStackPush()", "DebugStackPop()", and "BugAlert()" are all in
a module I call "basBugAlert".

The Push/Pop routines push the routine's name into an array/pop it out.

"BugAlert" refers to the array to get a trace of where we've been
just before the error popped. It then displays a little error screen to
the user and logs the error and the trace in a .TXT file.

The module is at the end of this note. If somebody can make it a little
better, I'd appreciate a copy of the improved code.

If you're trying to compile it and the line breaks are making you crazy, post
a reply and I'll email the .bas file to you.

-----------------------------------------------
Whatever()
DebugStackPush mModulename & ": Whatever"
On Error GoTo Whatever_err

' PURPOSE: To do whatever
' ACCEPTS:
' RETURNS:
'
' NOTES: 1).....


(code goes here...)

Whatever_xit:
DebugStackPop
On Error Resume Next
(release pointers, close recordsets)
Exit Sub

Whatever_err:
BugAlert True, ""
(optionally case out on Err if some errors are acceptable)
Resume Whatever_xit
----------------------------------------------
Option Compare Database 'Use database order for string comparisons
Option Explicit

' This module contains the routines used to trap/log errors and
' show the "bugAlert" screen.

' REQUIRES: 1) A table named "---------- Program Changes ----------" in the app
'
' 2) A global constant:
' Global Const gIniGroupName = "TretsParms"
'
' 3) Two forms:
' frmBugAlertConcise
' frmBugAlertVerbose
'
' NOTES: 1) To avoid loops, most of these routines should be using their own
own error trapping,
' which would be limited to just showing message boxes - as opposed
to potentially-recursive
' calls to debugStackPush() and debugStackPop()

Const mModuleName = "basBugAlert"

Global Const gStackLimit = 50

Const debugStackTotalSize = 52
Global gDebugStack(debugStackTotalSize)

Global gStackPointer As Integer

Global gErrorMessage As String 'For any calling routine
that wants to trap the error message before bugAlert munches on it.
Global gErrorLocation As String 'Ditto above, but contains
name of routine

Private Declare Function GetComputerName_bal Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName_bal Lib "advapi32.dll" Alias "GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName
As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize
As Long, ByVal lpFileName As String) As Long
Sub bugAlert(ByVal theDisplaySwitch As Integer, ByVal theSupplementalMessage As
String)

' PURPOSE: To log an error and, maybe, show an error screen to the user
' ACCEPTS: - A boolean telling whether-or-not to show a screen to the user
' - Supplemental text to be added to the log entry and shown on the
screen
' USES: - An optional .INI file parm called "myErrorPath", which tells where
to write the error
' - An optional .INI file parm called "VerboseErrorDisplay" that tells
us if we want
' to show frmBugAlertVerbose
'
' NOTES: 1) We are in error mode: anything could be happening.
' Therefore error trapping is limited to a messagebox.
' 2) We assume that the calling routine, after invoking this, will
gracefully proceed
' to it's "Exit" coding and pop the debug stack on the way out.
' 3) Note that out "On Error" statement isn't until *After* we've
captured error info.
' 4) Setting the display switch to False and suppling a supplemental
message allows the programmer
' to record things in the error log which did not result from
errors in the technical sense.
' e.g. bugAlert, False, "This sentence gets written to the error
log"
' 5) If there is no path specified in the .INI file, we write to the
root of C:

1001 Dim myErrorLine As Long
Dim myErrorNumber As Long
Dim myErrorMessage As String

1002 myErrorLine = Erl 'Capture relevant info ASAP
1003 myErrorNumber = Err
1004 myErrorMessage = Error$
1005 gErrorMessage = Error$
1006 gErrorLocation = gDebugStack(gStackPointer)

1007 On Error GoTo bugAlert_err
1008 DoCmd.Echo True 'In case it was turned off elsewhere

Dim v As Variant
Dim X As Integer
Dim myMessage As String
Dim myTimeStamp As String
Dim i As Integer
Dim L As Long
Dim myErrorPath As String
Dim myHeaderLine As String
Dim myAppVersion As String
Dim myVerboseSw As Boolean

Dim ParmValue As String

Const cannotDoAtThisTime = 2486

Dim skipLine As String

1010 skipLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & " "

1011 DoCmd.SetWarnings True

1020 ParmValue = String(255, 0)
1021 L = GetPrivateProfileString(gIniGroupName, "ErrorLogPath", "{NotFound}",
ParmValue, 255, SysCmd(acSysCmdIniFile))
1022 If L And Left(ParmValue, 10) <> "{NotFound}" Then
1023 myErrorPath = Left(ParmValue, L)
1024 Else
1025 myErrorPath = CurrentDb().Name
1026 If Right(myErrorPath, 4) = ".mdb" Then
1027 myErrorPath = Left(myErrorPath, Len(myErrorPath) - 4)
1028 End If
1029 myErrorPath = myErrorPath & ".Errors.txt"
1030 End If

1040 ParmValue = String(255, 0)
1041 L = GetPrivateProfileString(gIniGroupName, "VerboseErrorDisplay",
"{NotFound}", ParmValue, 255, SysCmd(acSysCmdIniFile))
1042 If L And Left(ParmValue, 10) <> "{NotFound}" Then
1043 If (Left(ParmValue, L) = "True") Or (Left(ParmValue, L) = "Yes") Then
1044 myVerboseSw = True
1045 End If
1046 End If

1049 myVerboseSw = True 'FORCE VERBOSE ERROR DISPLAY

1050 X = FreeFile
1051 Open myErrorPath For Append As X

1060 Print #X,
"-----------------------------------------------------------------"

1070 myAppVersion = currentVersionGet_bal
1071 myHeaderLine = VBA.Format$(Now, "mm/dd/yy hh:nn:ss") & myAppVersion & "
Userid: " & windozeIdGet_bal() & " on " & computerNameGet_bal()

1080 Print #X, myHeaderLine

1090 If theDisplaySwitch = False Then
1091 Print #X, "(ERROR SCREEN SUPPRESSED)"
1092 End If

1100 Print #X, " Proc: " & gDebugStack(gStackPointer)

1101 If myErrorNumber <> 0 Then
1102 If myErrorLine > 0 Then
1103 Print #X, String(9, " ") & "Line " & VBA.Format$(myErrorLine,
"000000") & " " & VBA.Format$(myErrorNumber, "0000") & ": " & myErrorMessage
1104 Else
1105 Print #X, String(13, " ") & VBA.Format$(myErrorNumber, "0000") & ": "
& myErrorMessage
1109 End If
1110 Else
1111 If myErrorLine > 0 Then
1112 Print #X, String(9, " ") & "Line " & VBA.Format$(myErrorLine,
"000000") & ": "
1113 Else
1114 Print #X, String(13, " ")
1115 End If
1119 End If

1120 If theSupplementalMessage <> "" Then
1121 Print #X, Space$(19) & theSupplementalMessage
1122 End If

1130 Print #X, ""

1140 If gStackPointer > 1 Then
1141 For i = 0 To gStackLimit
1142 If gDebugStack(i) <> "" Then
1143 If i = gStackPointer Then
1144 Print #X, Space$(9) & " " & Format(i, "00") & ">>" &
gDebugStack(i)
1145 Else
1146 If i = 1 Then
1150 Print #X, Space$(9) & "CallOuts: " & Format(i, "00") & " "
& gDebugStack(i)
1151 Else
1152 Print #X, Space$(9) & " " & Format(i, "00") & " "
& gDebugStack(i)
1153 End If
1154 End If
1155 End If
1156 Next i
1157 End If
1158 Close #X

1170 If theDisplaySwitch = True Then
1171 If myVerboseSw = True Then
1172 If myErrorLine > 0 Then
1173 myMessage = " " & "... at line " & Str(myErrorLine) & " in " &
Chr$(34) & gDebugStack(gStackPointer) & Chr$(34)
1174 Else
1175 myMessage = " " & "in " & Chr$(34) & gDebugStack(gStackPointer)
& Chr$(34)
1176 End If

1180 myMessage = myMessage & skipLine & "Error# " & Str(myErrorNumber) &
": " & myErrorMessage
1181 myMessage = myMessage & skipLine & theSupplementalMessage
1182 DoCmd.OpenForm "frmBugAlertVerbose", , , , , , myMessage
1183 Else
1184 DoCmd.OpenForm "frmBugAlertConcise", , , , , , myErrorPath
1185 End If
1999 End If

bugAlert_xit:
On Error Resume Next
Close #X
ExitSub

bugAlert_err:
Select Case Err
Case cannotDoAtThisTime
'Do nothing: There is probably a print dialog active, which prevents
opening the bugALert screen.
'Error has, however been writen to the error log...

Case Else
MsgBox "bugAlert() failed at line " & Str(Erl) & ", Error " & Str(Err) &
": " & Error$ & vbCrLf & "StackPointer=" & Val(gStackPointer) & vbCrLf & vbCrLf
& "Original error Info:" & vbCrLf & "Error " & Str(myErrorNumber) & " at line "
& Str(myErrorLine) & ": " & myErrorMessage & vbCrLf & theSupplementalMessage,
48, "Error In Error Handler"
stackFlush
End Select
Resume bugAlert_xit
End Sub
Sub stackFlush()

' PURPOSE: Flush the debug stack to the log file in case we find it is
overloaded
' ACCEPTS: - A boolean telling whether-or-not to show a screen to the user
' - Supplemental text to be added to the log entry and shown on the
screen

1010 Dim myErrorLine As Long
Dim myErrorNumber As Long
Dim myErrorMessage As String

1011 myErrorLine = Erl 'Capture relevant info ASAP
1012 myErrorNumber = Err
1013 myErrorMessage = Error$

1014 On Error GoTo stackFlush_err

Dim X As Integer
Dim i As Integer
Dim L As Long
Dim myErrorPath As String
Dim myHeaderLine As String
Dim myAppVersion As String

Dim ParmValue As String

Const myOptionGroup = "ProgramParms"
Const cannotDoAtThisTime = 2486

Dim skipLine As String
1020 skipLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & " "

1021 DoCmd.SetWarnings True

1030 ParmValue = String(255, 0)
1031 L = GetPrivateProfileString(myOptionGroup, "ErrorPath", "{NotFound}",
ParmValue, 255, SysCmd(acSysCmdIniFile))
1032 If L And Left(ParmValue, 10) <> "{NotFound}" Then
1033 myErrorPath = Left(ParmValue, L)
1034 Else
1035 myErrorPath = "C:\Error.txt"
1036 End If

1050 X = FreeFile
1051 Open myErrorPath For Append As X

1060 Print #X,
"-----------------------------------------------------------------"
1061 Print #X, "<================= STACK FLUSH
=================================>"

1071 myHeaderLine = VBA.Format$(Now, "mm/dd/yy hh:nn:ss") & " Userid: " &
CurrentUser() & " on " & computerNameGet_bal()

1080 Print #X, myHeaderLine
1100 Print #X, " Proc: " & gDebugStack(gStackPointer)
1130 Print #X, ""

1140 If gStackPointer > 1 Then
1141 For i = 0 To gStackLimit
1142 If gDebugStack(i) <> "" Then
1143 If i = gStackPointer Then
1144 Print #X, Space$(9) & " " & Format(i, "00") & ">>" &
gDebugStack(i)
1145 Else
1146 If i = 1 Then
1150 Print #X, Space$(9) & "CallOuts: " & Format(i, "00") & " "
& gDebugStack(i)
1151 Else
1152 Print #X, Space$(9) & " " & Format(i, "00") & " "
& gDebugStack(i)
1153 End If
1154 End If
1155 End If
1156 Next i
1157 End If
1999 Close #X

stackFlush_xit:
On Error Resume Next
Close #X
Exit Sub

stackFlush_err:
Select Case Err
Case cannotDoAtThisTime
'Do nothing: There is probably a print dialog active, which prevents
opening the stackFlush screen.
'Error has, however been writen to the error log...

Case Else
MsgBox "stackFlush() failed at line " & Str(Erl) & ", Error " & Str(Err)
& ": " & Error$ & vbCrLf & "StackPointer=" & Val(gStackPointer) & vbCrLf &
vbCrLf & "Original error Info:" & vbCrLf & "Error " & Str(myErrorNumber) & " at
line " & Str(myErrorLine) & ": " & myErrorMessage, 48, "Error In Error Handler"
End Select
Resume stackFlush_xit
End Sub
Sub aaTestBugAlert()
debugStackPush mModuleName & ": aaTestBugAlert"
On Error GoTo aaTestBugAlert_err

' PURPOSE: To supply a model for using the BugAlert routines and to demo the
routines
'
' NOTES: 1) Fire up a Debug window and type "aaTestBugAlert"

DoCmd.OpenForm "frmNon-Existant"

aaTestBugAlert_xit:
debugStackPop
On Error Resume Next
Exit Sub

aaTestBugAlert_err:
' bugAlert False, "This is the supplemental text...."
bugAlert True, "This is the supplemental text...."
Resume aaTestBugAlert_xit
End Sub
Sub debugStackPop()
On Error GoTo debugStackPop_err

' PURPOSE: To pop the last procedure name off the top of the debug stack

Dim i As Integer

If gStackPointer <= gStackLimit Then
gDebugStack(gStackPointer) = ""
End If

gStackPointer = gStackPointer - 1

If gStackPointer < 0 Then
gStackPointer = 0
End If

debugStackPop_xit:
On Error Resume Next
Exit Sub

debugStackPop_err:
MsgBox "debugStackPop() failed. Error " & Str(Err) & ": " & Error$, 48, "Error
In Error Handler"
Resume debugStackPop_xit
End Sub
Function debugStackPrint()
On Error GoTo debugStackPrint_err

Dim i As Integer

DoCmd.Hourglass True
Debug.Print "-------- Begin Debug Stack ---------"

For i = 1 To gStackPointer
Debug.Print VBA.Format$(i, "00") & ": " & gDebugStack(i)
Next i

Debug.Print "---------- End Debug Stack ---------"
DoCmd.Hourglass False

debugStackPrint_xit:
On Error Resume Next
Exit Function

debugStackPrint_err:
MsgBox "debugStackPrint() failed. Error " & Str(Err) & ": " & Error$, 48,
"Error In Error Handler"
Resume debugStackPrint_xit
End Function
Sub debugStackPush(ByVal theProcedureName As String)
On Error GoTo debugStackPush_err

' PURPOSE: To push a procedure name into the debug stack
' ACCEPTS: The procedure name
Dim i As Integer

gStackPointer = gStackPointer + 1

If gStackPointer <= gStackLimit Then
gDebugStack(gStackPointer) = theProcedureName
Else
gDebugStack(gStackLimit + 2) = theProcedureName
End If

debugStackPush_xit:
On Error Resume Next
Exit Sub

debugStackPush_err:
MsgBox "debugStackPush() failed. Error " & Str(Err) & ": " & Error$, 48,
"Error In Error Handler"
Resume debugStackPush_err
End Sub
Private Function computerNameGet_bal() As String
On Error GoTo computerNameGet_bal_err

' PURPOSE: To extract the name of the user's PC from via Windows API instead of
environment variables
' RETURNS: Name of user's PC or a blank string

Dim L As Long
Dim lpBuffer As String * 255
Dim myComputerName As String

L = GetComputerName_bal(lpBuffer, 255)
myComputerName = stripNulls_bal(lpBuffer)

computerNameGet_bal = myComputerName

computerNameGet_bal_xit:
On Error Resume Next
Exit Function

computerNameGet_bal_err:
MsgBox "computerNameGet_bal() failed. Error " & Str(Err) & ": " & Error$, 48,
"Error In Error Handler"
Resume computerNameGet_bal_xit
End Function
Private Function stripNulls_bal(theOriginalString As String)
On Error GoTo stripNulls_bal_err

If InStr(1, theOriginalString, Chr(0), vbTextCompare) Then
theOriginalString = Mid(theOriginalString, 1, InStr(theOriginalString,
Chr(0)) - 1)
End If

stripNulls_bal = theOriginalString

stripNulls_bal_xit:
On Error Resume Next
Exit Function

stripNulls_bal_err:
MsgBox "stipNulls() failed. Error " & Str(Err) & ": " & Error$, 48, "Error In
Error Handler"
Resume stripNulls_bal_xit
End Function
Private Function currentVersionGet_bal() As String
1001 On Error GoTo currentVersionGet_bal_err

' PURPOSE: To retrieve the current version of the app
' RETURNS: Current version of the app as a formatted number. e.g. "5.31"
' USES: A special application-resident table named "---------- Program
Changes ----------"
'
' NOTES: 1) The table's name is designed to float it to the top of the table
list and call attention
' to the fact that is something out-of-the-ordinary table-wise

1010 Dim myRS As DAO.Recordset

Static myCurrentVersion As String

1060 If Len(myCurrentVersion) = 0 Then
1160 Set myRS = CurrentDb().OpenRecordset("SELECT Max([---------- Program
Changes ----------].versionNumber) AS MaxOfversionNumber FROM [----------
Program Changes ----------];", dbOpenSnapshot)
1180 myCurrentVersion = "v" & VBA.Format$(Nz(myRS!MaxOfversionNumber,
"0.00"))
1240 End If

1999 currentVersionGet_bal = myCurrentVersion

currentVersionGet_bal_xit:
On Error Resume Next
myRS.Close
Set myRS = Nothing
Exit Function

currentVersionGet_bal_err:
MsgBox "currentVersionGet() failed at line " & Str(Erl) & ", Error " & Str(Err)
& ": " & Error$, 48, "Error In Error Handler"
Resume currentVersionGet_bal_xit
End Function
Sub stackClear()

' PURPOSE: To clear the debug stack. Intended for use while debugging.

Dim i As Integer

If gStackPointer > 1 Then
For i = 0 To gStackLimit
If gDebugStack(i) <> "" Then
gDebugStack(i) = ""
End If
Next i
End If

gStackPointer = 0

stackClear_xit:
On Error Resume Next
Exit Sub

stackClear_err:
Resume stackClear_xit
End Sub
Private Function windozeIdGet_bal()
On Error GoTo windozeIdGet_bal_err

' PURPOSE: To get the current Windows UserID
' RETURNS: ID or error message

Dim myBuffer As String * 255
Dim myUserName As String

GetUserName_bal myBuffer, Len(myBuffer) 'Get the
user name
myUserName = Left(Trim(myBuffer), InStr(myBuffer, Chr(0)) - 1) 'Trim excess
characters

If Len(myUserName) > 0 Then
windozeIdGet_bal = myUserName
Else
windozeIdGet_bal "windozeIdGet_bal() Unable to get Windows UserID"
End If

windozeIdGet_bal_xit:
On Error Resume Next
Exit Function

windozeIdGet_bal_err:
MsgBox "stipNulls() failed. Error " & Str(Err) & ": " & Error$, 48, "Error In
Error Handler"
Resume windozeIdGet_bal_xit
End Function
----------------------------------------------
--
PeteCresswell

re: Error Handler best practices

Surely -- code it right in. Some third party tools hold it in a compile-time
variable and you can insert that variable. Check a free tool of this kind
CodeWrite2 at MVP Arvin Meyer's site, http://www.datastrat.com.

Larry Linson
Microsoft Access MVP


"deko" <dje422@hotmail.com> wrote in message
news:IsNBb.69418$i05.6435@newssvr25.news.prodigy.c om...[color=blue]
> I use this convention frequently:
>
> Exit_Here:
> Exit Sub
> HandleErr:
> Select Case Err.Number
> Case 3163
> Resume Next
> Case 3376
> Resume Next
> Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description
> Resume Exit_Here
> End Select
>
> Is there a way to include the current procedure name on Case Else?
>
> perhaps something like this:
>
> Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description &
> vbCrLf & _
> Me.ProcedureName & Me.Form
> Resume Exit_Here
> End Select
> (note: "Me.ProcedureName" is pseudo code - I don't know if it's possible[/color]
to[color=blue]
> get this...)
>
> How about offloading this to a module so I don't have to type it out every
> time:
>
> Case Else
> strP = Me!Procedure
> strF = Me.Form
> modErr.caseElse
> End Select
>
> thoughts ? suggestions ?
>
> Thanks in advance...
>
>[/color]

re: Error Handler best practices

On Wed, 10 Dec 2003 22:52:24 GMT, "deko" <dje422@hotmail.com> wrote:

Literally: no.
Therefore in VBA people often resort to secondary solutions. For
example at the top of each function you "Push" the name of the current
function on a stack, and at the bottom you "Pop" it off again. This
boilerplate code can be added by writing some code that works with the
Module object.

In .NET you *do* have access to a Stack object, so you can do what you
ask for, and more.

-Tom.

[color=blue]
>I use this convention frequently:
>
>Exit_Here:
> Exit Sub
>HandleErr:
> Select Case Err.Number
> Case 3163
> Resume Next
> Case 3376
> Resume Next
> Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description
> Resume Exit_Here
> End Select
>
>Is there a way to include the current procedure name on Case Else?
>
>perhaps something like this:
>
>Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description &
>vbCrLf & _
> Me.ProcedureName & Me.Form
> Resume Exit_Here
>End Select
>(note: "Me.ProcedureName" is pseudo code - I don't know if it's possible to
>get this...)
>
>How about offloading this to a module so I don't have to type it out every
>time:
>
>Case Else
> strP = Me!Procedure
> strF = Me.Form
> modErr.caseElse
>End Select
>
>thoughts ? suggestions ?
>
>Thanks in advance...
>[/color]

re: Error Handler best practices

You might want an "On Error Resume Next" as the first thing in your
Exit section.

Exit_Here:
On Error Resume Next
'do some stuff here
Exit Sub

Reason: if an error gets raised in the Exit section, your
ErrorHandler will go into an infinite loop.

-Matt

On Wed, 10 Dec 2003 22:52:24 GMT, "deko" <dje422@hotmail.com> wrote:
[color=blue]
>Exit_Here:
> Exit Sub[/color]

re: Error Handler best practices

good point...

"Matthew Sullivan" <Matt@NoSpam.com> wrote in message
news:lkmftvcnohk4jskpsii7g70419snl22mqb@4ax.com...[color=blue]
> You might want an "On Error Resume Next" as the first thing in your
> Exit section.
>
> Exit_Here:
> On Error Resume Next
> 'do some stuff here
> Exit Sub
>
> Reason: if an error gets raised in the Exit section, your
> ErrorHandler will go into an infinite loop.
>
> -Matt
>
> On Wed, 10 Dec 2003 22:52:24 GMT, "deko" <dje422@hotmail.com> wrote:
>[color=green]
> >Exit_Here:
> > Exit Sub[/color]
>[/color]

re: Error Handler best practices

Have a look at MZ-Tools. This will automate writing error handlers for you
an dyou can edit the error hanldler it inserts.

Plus it does an awful lot of other things that you will find useful.

http://www.mztools.com/


Terry

"deko" <dje422@hotmail.com> wrote in message
news:IsNBb.69418$i05.6435@newssvr25.news.prodigy.c om...[color=blue]
> I use this convention frequently:
>
> Exit_Here:
> Exit Sub
> HandleErr:
> Select Case Err.Number
> Case 3163
> Resume Next
> Case 3376
> Resume Next
> Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description
> Resume Exit_Here
> End Select
>
> Is there a way to include the current procedure name on Case Else?
>
> perhaps something like this:
>
> Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description &
> vbCrLf & _
> Me.ProcedureName & Me.Form
> Resume Exit_Here
> End Select
> (note: "Me.ProcedureName" is pseudo code - I don't know if it's possible[/color]
to[color=blue]
> get this...)
>
> How about offloading this to a module so I don't have to type it out every
> time:
>
> Case Else
> strP = Me!Procedure
> strF = Me.Form
> modErr.caseElse
> End Select
>
> thoughts ? suggestions ?
>
> Thanks in advance...
>
>[/color]

re: Error Handler best practices

thanks for the tip... will check it out...

"Terry Kreft" <terry.kreft@mps.co.uk> wrote in message
news:2q2dnf3GepK9-kWiSa8jmA@karoo.co.uk...[color=blue]
> Have a look at MZ-Tools. This will automate writing error handlers for you
> an dyou can edit the error hanldler it inserts.
>
> Plus it does an awful lot of other things that you will find useful.
>
> http://www.mztools.com/
>
>
> Terry
>
> "deko" <dje422@hotmail.com> wrote in message
> news:IsNBb.69418$i05.6435@newssvr25.news.prodigy.c om...[color=green]
> > I use this convention frequently:
> >
> > Exit_Here:
> > Exit Sub
> > HandleErr:
> > Select Case Err.Number
> > Case 3163
> > Resume Next
> > Case 3376
> > Resume Next
> > Case Else
> > MsgBox "Error Number " & Err.Number & ": " & Err.Description
> > Resume Exit_Here
> > End Select
> >
> > Is there a way to include the current procedure name on Case Else?
> >
> > perhaps something like this:
> >
> > Case Else
> > MsgBox "Error Number " & Err.Number & ": " & Err.Description[/color][/color]
&[color=blue][color=green]
> > vbCrLf & _
> > Me.ProcedureName & Me.Form
> > Resume Exit_Here
> > End Select
> > (note: "Me.ProcedureName" is pseudo code - I don't know if it's possible[/color]
> to[color=green]
> > get this...)
> >
> > How about offloading this to a module so I don't have to type it out[/color][/color]
every[color=blue][color=green]
> > time:
> >
> > Case Else
> > strP = Me!Procedure
> > strF = Me.Form
> > modErr.caseElse
> > End Select
> >
> > thoughts ? suggestions ?
> >
> > Thanks in advance...
> >
> >[/color]
>
>[/color]

re: Error Handler best practices

Matt@NoSpam.com (Matthew Sullivan) wrote in
<lkmftvcnohk4jskpsii7g70419snl22mqb@4ax.com>:
[color=blue]
>You might want an "On Error Resume Next" as the first thing in
>your Exit section.
>
>Exit_Here:
> On Error Resume Next
> 'do some stuff here
> Exit Sub
>
>Reason: if an error gets raised in the Exit section, your
>ErrorHandler will go into an infinite loop.[/color]

Er, I've never written a single error handler with that in it, nor
ever seen one in any of the Access books I've used, and I've never
encountered an error in an error handler. Of course, the only thing
I ever do in an error handler is to display an error message and
redirect to the appropriate location in code.

--
David W. Fenton http://www.bway.net/~dfenton
dfenton at bway dot net http://www.bway.net/~dfassoc

re: Error Handler best practices

Thanks... you may be getting me in over my head, but I'll see if I can get
that module to work in my mdb...

for now, I've come up with this:

Exit_Here:
On Error Resume Next
Exit Sub
HandleErr:
Select Case Err.Number
Case Else
Dim fn As String
fn = Me.Form.Name
modHandler.Ermsg (fn)
Resume Exit_Here
End Select

Here is code for modHandler:

Public Sub Ermsg (fn)
MsgBox "Error Number " & Err.Number & ": " & Err.Description & vbCrLf &
fn
End Sub

the next step is putting this into every procedure in the database...
perhaps there is a way to automate this... ?


"(Pete Cresswell)" <x@y.z> wrote in message
news:giiftvo5bc9jqrenpoinaeov7pf6freph4@4ax.com...[color=blue]
> RE/[color=green]
> >I use this convention frequently:
> >
> >Exit_Here:
> > Exit Sub
> >HandleErr:
> > Select Case Err.Number
> > Case 3163
> > Resume Next
> > Case 3376
> > Resume Next
> > Case Else
> > MsgBox "Error Number " & Err.Number & ": " & Err.Description
> > Resume Exit_Here
> > End Select
> >
> >Is there a way to include the current procedure name on Case Else?
> >
> >perhaps something like this:
> >
> >Case Else
> > MsgBox "Error Number " & Err.Number & ": " & Err.Description[/color][/color]
&[color=blue][color=green]
> >vbCrLf & _
> > Me.ProcedureName & Me.Form
> > Resume Exit_Here
> >End Select
> >(note: "Me.ProcedureName" is pseudo code - I don't know if it's possible[/color][/color]
to[color=blue][color=green]
> >get this...)
> >
> >How about offloading this to a module so I don't have to type it out[/color][/color]
every[color=blue][color=green]
> >time:
> >
> >Case Else
> > strP = Me!Procedure
> > strF = Me.Form
> > modErr.caseElse
> >End Select
> >
> >thoughts ? suggestions ?
> >
> >Thanks in advance...
> >[/color]
>
> Every routine I write is within the skeleton below.
>
> "DebugStackPush()", "DebugStackPop()", and "BugAlert()" are all in
> a module I call "basBugAlert".
>
> The Push/Pop routines push the routine's name into an array/pop it out.
>
> "BugAlert" refers to the array to get a trace of where we've been
> just before the error popped. It then displays a little error screen to
> the user and logs the error and the trace in a .TXT file.
>
> The module is at the end of this note. If somebody can make it a little
> better, I'd appreciate a copy of the improved code.
>
> If you're trying to compile it and the line breaks are making you crazy,[/color]
post[color=blue]
> a reply and I'll email the .bas file to you.
>
> -----------------------------------------------
> Whatever()
> DebugStackPush mModulename & ": Whatever"
> On Error GoTo Whatever_err
>
> ' PURPOSE: To do whatever
> ' ACCEPTS:
> ' RETURNS:
> '
> ' NOTES: 1).....
>
>
> (code goes here...)
>
> Whatever_xit:
> DebugStackPop
> On Error Resume Next
> (release pointers, close recordsets)
> Exit Sub
>
> Whatever_err:
> BugAlert True, ""
> (optionally case out on Err if some errors are acceptable)
> Resume Whatever_xit
> ----------------------------------------------
> Option Compare Database 'Use database order for string comparisons
> Option Explicit
>
> ' This module contains the routines used to trap/log errors and
> ' show the "bugAlert" screen.
>
> ' REQUIRES: 1) A table named "---------- Program Changes ----------" in[/color]
the app[color=blue]
> '
> ' 2) A global constant:
> ' Global Const gIniGroupName = "TretsParms"
> '
> ' 3) Two forms:
> ' frmBugAlertConcise
> ' frmBugAlertVerbose
> '
> ' NOTES: 1) To avoid loops, most of these routines should be using[/color]
their own[color=blue]
> own error trapping,
> ' which would be limited to just showing message boxes - as[/color]
opposed[color=blue]
> to potentially-recursive
> ' calls to debugStackPush() and debugStackPop()
>
> Const mModuleName = "basBugAlert"
>
> Global Const gStackLimit = 50
>
> Const debugStackTotalSize = 52
> Global gDebugStack(debugStackTotalSize)
>
> Global gStackPointer As Integer
>
> Global gErrorMessage As String 'For any calling[/color]
routine[color=blue]
> that wants to trap the error message before bugAlert munches on it.
> Global gErrorLocation As String 'Ditto above, but[/color]
contains[color=blue]
> name of routine
>
> Private Declare Function GetComputerName_bal Lib "kernel32" Alias
> "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
> Private Declare Function GetUserName_bal Lib "advapi32.dll" Alias[/color]
"GetUserNameA"[color=blue]
> (ByVal lpBuffer As String, nSize As Long) As Long
> Private Declare Function GetPrivateProfileString Lib "kernel32" Alias
> "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal[/color]
lpKeyName[color=blue]
> As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal[/color]
nSize[color=blue]
> As Long, ByVal lpFileName As String) As Long
> Sub bugAlert(ByVal theDisplaySwitch As Integer, ByVal[/color]
theSupplementalMessage As[color=blue]
> String)
>
> ' PURPOSE: To log an error and, maybe, show an error screen to the user
> ' ACCEPTS: - A boolean telling whether-or-not to show a screen to the[/color]
user[color=blue]
> ' - Supplemental text to be added to the log entry and shown on[/color]
the[color=blue]
> screen
> ' USES: - An optional .INI file parm called "myErrorPath", which tells[/color]
where[color=blue]
> to write the error
> ' - An optional .INI file parm called "VerboseErrorDisplay" that[/color]
tells[color=blue]
> us if we want
> ' to show frmBugAlertVerbose
> '
> ' NOTES: 1) We are in error mode: anything could be happening.
> ' Therefore error trapping is limited to a messagebox.
> ' 2) We assume that the calling routine, after invoking this,[/color]
will[color=blue]
> gracefully proceed
> ' to it's "Exit" coding and pop the debug stack on the way[/color]
out.[color=blue]
> ' 3) Note that out "On Error" statement isn't until *After*[/color]
we've[color=blue]
> captured error info.
> ' 4) Setting the display switch to False and suppling a[/color]
supplemental[color=blue]
> message allows the programmer
> ' to record things in the error log which did not result from
> errors in the technical sense.
> ' e.g. bugAlert, False, "This sentence gets written to the[/color]
error[color=blue]
> log"
> ' 5) If there is no path specified in the .INI file, we write to[/color]
the[color=blue]
> root of C:
>
> 1001 Dim myErrorLine As Long
> Dim myErrorNumber As Long
> Dim myErrorMessage As String
>
> 1002 myErrorLine = Erl 'Capture relevant info ASAP
> 1003 myErrorNumber = Err
> 1004 myErrorMessage = Error$
> 1005 gErrorMessage = Error$
> 1006 gErrorLocation = gDebugStack(gStackPointer)
>
> 1007 On Error GoTo bugAlert_err
> 1008 DoCmd.Echo True 'In case it was turned off[/color]
elsewhere[color=blue]
>
> Dim v As Variant
> Dim X As Integer
> Dim myMessage As String
> Dim myTimeStamp As String
> Dim i As Integer
> Dim L As Long
> Dim myErrorPath As String
> Dim myHeaderLine As String
> Dim myAppVersion As String
> Dim myVerboseSw As Boolean
>
> Dim ParmValue As String
>
> Const cannotDoAtThisTime = 2486
>
> Dim skipLine As String
>
> 1010 skipLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & " "
>
> 1011 DoCmd.SetWarnings True
>
> 1020 ParmValue = String(255, 0)
> 1021 L = GetPrivateProfileString(gIniGroupName, "ErrorLogPath",[/color]
"{NotFound}",[color=blue]
> ParmValue, 255, SysCmd(acSysCmdIniFile))
> 1022 If L And Left(ParmValue, 10) <> "{NotFound}" Then
> 1023 myErrorPath = Left(ParmValue, L)
> 1024 Else
> 1025 myErrorPath = CurrentDb().Name
> 1026 If Right(myErrorPath, 4) = ".mdb" Then
> 1027 myErrorPath = Left(myErrorPath, Len(myErrorPath) - 4)
> 1028 End If
> 1029 myErrorPath = myErrorPath & ".Errors.txt"
> 1030 End If
>
> 1040 ParmValue = String(255, 0)
> 1041 L = GetPrivateProfileString(gIniGroupName, "VerboseErrorDisplay",
> "{NotFound}", ParmValue, 255, SysCmd(acSysCmdIniFile))
> 1042 If L And Left(ParmValue, 10) <> "{NotFound}" Then
> 1043 If (Left(ParmValue, L) = "True") Or (Left(ParmValue, L) = "Yes")[/color]
Then[color=blue]
> 1044 myVerboseSw = True
> 1045 End If
> 1046 End If
>
> 1049 myVerboseSw = True 'FORCE VERBOSE ERROR DISPLAY
>
> 1050 X = FreeFile
> 1051 Open myErrorPath For Append As X
>
> 1060 Print #X,
> "-----------------------------------------------------------------"
>
> 1070 myAppVersion = currentVersionGet_bal
> 1071 myHeaderLine = VBA.Format$(Now, "mm/dd/yy hh:nn:ss") & myAppVersion[/color]
& "[color=blue]
> Userid: " & windozeIdGet_bal() & " on " & computerNameGet_bal()
>
> 1080 Print #X, myHeaderLine
>
> 1090 If theDisplaySwitch = False Then
> 1091 Print #X, "(ERROR SCREEN SUPPRESSED)"
> 1092 End If
>
> 1100 Print #X, " Proc: " & gDebugStack(gStackPointer)
>
> 1101 If myErrorNumber <> 0 Then
> 1102 If myErrorLine > 0 Then
> 1103 Print #X, String(9, " ") & "Line " & VBA.Format$(myErrorLine,
> "000000") & " " & VBA.Format$(myErrorNumber, "0000") & ": " &[/color]
myErrorMessage[color=blue]
> 1104 Else
> 1105 Print #X, String(13, " ") & VBA.Format$(myErrorNumber, "0000")[/color]
& ": "[color=blue]
> & myErrorMessage
> 1109 End If
> 1110 Else
> 1111 If myErrorLine > 0 Then
> 1112 Print #X, String(9, " ") & "Line " & VBA.Format$(myErrorLine,
> "000000") & ": "
> 1113 Else
> 1114 Print #X, String(13, " ")
> 1115 End If
> 1119 End If
>
> 1120 If theSupplementalMessage <> "" Then
> 1121 Print #X, Space$(19) & theSupplementalMessage
> 1122 End If
>
> 1130 Print #X, ""
>
> 1140 If gStackPointer > 1 Then
> 1141 For i = 0 To gStackLimit
> 1142 If gDebugStack(i) <> "" Then
> 1143 If i = gStackPointer Then
> 1144 Print #X, Space$(9) & " " & Format(i, "00") &[/color]
">>" &[color=blue]
> gDebugStack(i)
> 1145 Else
> 1146 If i = 1 Then
> 1150 Print #X, Space$(9) & "CallOuts: " & Format(i, "00") &[/color]
" "[color=blue]
> & gDebugStack(i)
> 1151 Else
> 1152 Print #X, Space$(9) & " " & Format(i, "00") &[/color]
" "[color=blue]
> & gDebugStack(i)
> 1153 End If
> 1154 End If
> 1155 End If
> 1156 Next i
> 1157 End If
> 1158 Close #X
>
> 1170 If theDisplaySwitch = True Then
> 1171 If myVerboseSw = True Then
> 1172 If myErrorLine > 0 Then
> 1173 myMessage = " " & "... at line " & Str(myErrorLine) & "[/color]
in " &[color=blue]
> Chr$(34) & gDebugStack(gStackPointer) & Chr$(34)
> 1174 Else
> 1175 myMessage = " " & "in " & Chr$(34) &[/color]
gDebugStack(gStackPointer)[color=blue]
> & Chr$(34)
> 1176 End If
>
> 1180 myMessage = myMessage & skipLine & "Error# " &[/color]
Str(myErrorNumber) &[color=blue]
> : " & myErrorMessage
> 1181 myMessage = myMessage & skipLine & theSupplementalMessage
> 1182 DoCmd.OpenForm "frmBugAlertVerbose", , , , , , myMessage
> 1183 Else
> 1184 DoCmd.OpenForm "frmBugAlertConcise", , , , , , myErrorPath
> 1185 End If
> 1999 End If
>
> bugAlert_xit:
> On Error Resume Next
> Close #X
> Exit Sub
>
> bugAlert_err:
> Select Case Err
> Case cannotDoAtThisTime
> 'Do nothing: There is probably a print dialog active, which[/color]
prevents[color=blue]
> opening the bugALert screen.
> 'Error has, however been writen to the error log...
>
> Case Else
> MsgBox "bugAlert() failed at line " & Str(Erl) & ", Error " &[/color]
Str(Err) &[color=blue]
> ": " & Error$ & vbCrLf & "StackPointer=" & Val(gStackPointer) & vbCrLf &[/color]
vbCrLf[color=blue]
> & "Original error Info:" & vbCrLf & "Error " & Str(myErrorNumber) & " at[/color]
line "[color=blue]
> & Str(myErrorLine) & ": " & myErrorMessage & vbCrLf &[/color]
theSupplementalMessage,[color=blue]
> 48, "Error In Error Handler"
> stackFlush
> End Select
> Resume bugAlert_xit
> End Sub
> Sub stackFlush()
>
> ' PURPOSE: Flush the debug stack to the log file in case we find it is
> overloaded
> ' ACCEPTS: - A boolean telling whether-or-not to show a screen to the[/color]
user[color=blue]
> ' - Supplemental text to be added to the log entry and shown on[/color]
the[color=blue]
> screen
>
> 1010 Dim myErrorLine As Long
> Dim myErrorNumber As Long
> Dim myErrorMessage As String
>
> 1011 myErrorLine = Erl 'Capture relevant info ASAP
> 1012 myErrorNumber = Err
> 1013 myErrorMessage = Error$
>
> 1014 On Error GoTo stackFlush_err
>
> Dim X As Integer
> Dim i As Integer
> Dim L As Long
> Dim myErrorPath As String
> Dim myHeaderLine As String
> Dim myAppVersion As String
>
> Dim ParmValue As String
>
> Const myOptionGroup = "ProgramParms"
> Const cannotDoAtThisTime = 2486
>
> Dim skipLine As String
> 1020 skipLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & " "
>
> 1021 DoCmd.SetWarnings True
>
> 1030 ParmValue = String(255, 0)
> 1031 L = GetPrivateProfileString(myOptionGroup, "ErrorPath",[/color]
"{NotFound}",[color=blue]
> ParmValue, 255, SysCmd(acSysCmdIniFile))
> 1032 If L And Left(ParmValue, 10) <> "{NotFound}" Then
> 1033 myErrorPath = Left(ParmValue, L)
> 1034 Else
> 1035 myErrorPath = "C:\Error.txt"
> 1036 End If
>
> 1050 X = FreeFile
> 1051 Open myErrorPath For Append As X
>
> 1060 Print #X,
> "-----------------------------------------------------------------"
> 1061 Print #X, "<================= STACK FLUSH
> =================================>"
>
> 1071 myHeaderLine = VBA.Format$(Now, "mm/dd/yy hh:nn:ss") & " Userid: " &
> CurrentUser() & " on " & computerNameGet_bal()
>
> 1080 Print #X, myHeaderLine
> 1100 Print #X, " Proc: " & gDebugStack(gStackPointer)
> 1130 Print #X, ""
>
> 1140 If gStackPointer > 1 Then
> 1141 For i = 0 To gStackLimit
> 1142 If gDebugStack(i) <> "" Then
> 1143 If i = gStackPointer Then
> 1144 Print #X, Space$(9) & " " & Format(i, "00") &[/color]
">>" &[color=blue]
> gDebugStack(i)
> 1145 Else
> 1146 If i = 1 Then
> 1150 Print #X, Space$(9) & "CallOuts: " & Format(i, "00") &[/color]
" "[color=blue]
> & gDebugStack(i)
> 1151 Else
> 1152 Print #X, Space$(9) & " " & Format(i, "00") &[/color]
" "[color=blue]
> & gDebugStack(i)
> 1153 End If
> 1154 End If
> 1155 End If
> 1156 Next i
> 1157 End If
> 1999 Close #X
>
> stackFlush_xit:
> On Error Resume Next
> Close #X
> Exit Sub
>
> stackFlush_err:
> Select Case Err
> Case cannotDoAtThisTime
> 'Do nothing: There is probably a print dialog active, which[/color]
prevents[color=blue]
> opening the stackFlush screen.
> 'Error has, however been writen to the error log...
>
> Case Else
> MsgBox "stackFlush() failed at line " & Str(Erl) & ", Error " &[/color]
Str(Err)[color=blue]
> & ": " & Error$ & vbCrLf & "StackPointer=" & Val(gStackPointer) & vbCrLf &
> vbCrLf & "Original error Info:" & vbCrLf & "Error " & Str(myErrorNumber) &[/color]
" at[color=blue]
> line " & Str(myErrorLine) & ": " & myErrorMessage, 48, "Error In Error[/color]
Handler"[color=blue]
> End Select
> Resume stackFlush_xit
> End Sub
> Sub aaTestBugAlert()
> debugStackPush mModuleName & ": aaTestBugAlert"
> On Error GoTo aaTestBugAlert_err
>
> ' PURPOSE: To supply a model for using the BugAlert routines and to demo[/color]
the[color=blue]
> routines
> '
> ' NOTES: 1) Fire up a Debug window and type "aaTestBugAlert"
>
> DoCmd.OpenForm "frmNon-Existant"
>
> aaTestBugAlert_xit:
> debugStackPop
> On Error Resume Next
> Exit Sub
>
> aaTestBugAlert_err:
> ' bugAlert False, "This is the supplemental text...."
> bugAlert True, "This is the supplemental text...."
> Resume aaTestBugAlert_xit
> End Sub
> Sub debugStackPop()
> On Error GoTo debugStackPop_err
>
> ' PURPOSE: To pop the last procedure name off the top of the debug stack
>
> Dim i As Integer
>
> If gStackPointer <= gStackLimit Then
> gDebugStack(gStackPointer) = ""
> End If
>
> gStackPointer = gStackPointer - 1
>
> If gStackPointer < 0 Then
> gStackPointer = 0
> End If
>
> debugStackPop_xit:
> On Error Resume Next
> Exit Sub
>
> debugStackPop_err:
> MsgBox "debugStackPop() failed. Error " & Str(Err) & ": " & Error$, 48,[/color]
"Error[color=blue]
> In Error Handler"
> Resume debugStackPop_xit
> End Sub
> Function debugStackPrint()
> On Error GoTo debugStackPrint_err
>
> Dim i As Integer
>
> DoCmd.Hourglass True
> Debug.Print "-------- Begin Debug Stack ---------"
>
> For i = 1 To gStackPointer
> Debug.Print VBA.Format$(i, "00") & ": " & gDebugStack(i)
> Next i
>
> Debug.Print "---------- End Debug Stack ---------"
> DoCmd.Hourglass False
>
> debugStackPrint_xit:
> On Error Resume Next
> Exit Function
>
> debugStackPrint_err:
> MsgBox "debugStackPrint() failed. Error " & Str(Err) & ": " & Error$,[/color]
48,[color=blue]
> "Error In Error Handler"
> Resume debugStackPrint_xit
> End Function
> Sub debugStackPush(ByVal theProcedureName As String)
> On Error GoTo debugStackPush_err
>
> ' PURPOSE: To push a procedure name into the debug stack
> ' ACCEPTS: The procedure name
> Dim i As Integer
>
> gStackPointer = gStackPointer + 1
>
> If gStackPointer <= gStackLimit Then
> gDebugStack(gStackPointer) = theProcedureName
> Else
> gDebugStack(gStackLimit + 2) = theProcedureName
> End If
>
> debugStackPush_xit:
> On Error Resume Next
> Exit Sub
>
> debugStackPush_err:
> MsgBox "debugStackPush() failed. Error " & Str(Err) & ": " & Error$, 48,
> "Error In Error Handler"
> Resume debugStackPush_err
> End Sub
> Private Function computerNameGet_bal() As String
> On Error GoTo computerNameGet_bal_err
>
> ' PURPOSE: To extract the name of the user's PC from via Windows API[/color]
instead of[color=blue]
> environment variables
> ' RETURNS: Name of user's PC or a blank string
>
> Dim L As Long
> Dim lpBuffer As String * 255
> Dim myComputerName As String
>
> L = GetComputerName_bal(lpBuffer, 255)
> myComputerName = stripNulls_bal(lpBuffer)
>
> computerNameGet_bal = myComputerName
>
> computerNameGet_bal_xit:
> On Error Resume Next
> Exit Function
>
> computerNameGet_bal_err:
> MsgBox "computerNameGet_bal() failed. Error " & Str(Err) & ": " &[/color]
Error$, 48,[color=blue]
> "Error In Error Handler"
> Resume computerNameGet_bal_xit
> End Function
> Private Function stripNulls_bal(theOriginalString As String)
> On Error GoTo stripNulls_bal_err
>
> If InStr(1, theOriginalString, Chr(0), vbTextCompare) Then
> theOriginalString = Mid(theOriginalString, 1,[/color]
InStr(theOriginalString,[color=blue]
> Chr(0)) - 1)
> End If
>
> stripNulls_bal = theOriginalString
>
> stripNulls_bal_xit:
> On Error Resume Next
> Exit Function
>
> stripNulls_bal_err:
> MsgBox "stipNulls() failed. Error " & Str(Err) & ": " & Error$, 48,[/color]
"Error In[color=blue]
> Error Handler"
> Resume stripNulls_bal_xit
> End Function
> Private Function currentVersionGet_bal() As String
> 1001 On Error GoTo currentVersionGet_bal_err
>
> ' PURPOSE: To retrieve the current version of the app
> ' RETURNS: Current version of the app as a formatted number. e.g.[/color]
"5.31"[color=blue]
> ' USES: A special application-resident table named "---------- Program
> Changes ----------"
> '
> ' NOTES: 1) The table's name is designed to float it to the top of the[/color]
table[color=blue]
> list and call attention
> ' to the fact that is something out-of-the-ordinary table-wise
>
> 1010 Dim myRS As DAO.Recordset
>
> Static myCurrentVersion As String
>
> 1060 If Len(myCurrentVersion) = 0 Then
> 1160 Set myRS = CurrentDb().OpenRecordset("SELECT Max([----------[/color]
Program[color=blue]
> Changes ----------].versionNumber) AS MaxOfversionNumber FROM [----------
> Program Changes ----------];", dbOpenSnapshot)
> 1180 myCurrentVersion = "v" & VBA.Format$(Nz(myRS!MaxOfversionNumber,
> "0.00"))
> 1240 End If
>
> 1999 currentVersionGet_bal = myCurrentVersion
>
> currentVersionGet_bal_xit:
> On Error Resume Next
> myRS.Close
> Set myRS = Nothing
> Exit Function
>
> currentVersionGet_bal_err:
> MsgBox "currentVersionGet() failed at line " & Str(Erl) & ", Error " &[/color]
Str(Err)[color=blue]
> & ": " & Error$, 48, "Error In Error Handler"
> Resume currentVersionGet_bal_xit
> End Function
> Sub stackClear()
>
> ' PURPOSE: To clear the debug stack. Intended for use while debugging.
>
> Dim i As Integer
>
> If gStackPointer > 1 Then
> For i = 0 To gStackLimit
> If gDebugStack(i) <> "" Then
> gDebugStack(i) = ""
> End If
> Next i
> End If
>
> gStackPointer = 0
>
> stackClear_xit:
> On Error Resume Next
> Exit Sub
>
> stackClear_err:
> Resume stackClear_xit
> End Sub
> Private Function windozeIdGet_bal()
> On Error GoTo windozeIdGet_bal_err
>
> ' PURPOSE: To get the current Windows UserID
> ' RETURNS: ID or error message
>
> Dim myBuffer As String * 255
> Dim myUserName As String
>
> GetUserName_bal myBuffer, Len(myBuffer) 'Get[/color]
the[color=blue]
> user name
> myUserName = Left(Trim(myBuffer), InStr(myBuffer, Chr(0)) - 1) 'Trim[/color]
excess[color=blue]
> characters
>
> If Len(myUserName) > 0 Then
> windozeIdGet_bal = myUserName
> Else
> windozeIdGet_bal "windozeIdGet_bal() Unable to get Windows UserID"
> End If
>
> windozeIdGet_bal_xit:
> On Error Resume Next
> Exit Function
>
> windozeIdGet_bal_err:
> MsgBox "stipNulls() failed. Error " & Str(Err) & ": " & Error$, 48,[/color]
"Error In[color=blue]
> Error Handler"
> Resume windozeIdGet_bal_xit
> End Function
> ----------------------------------------------
> --
> PeteCresswell
>[/color]

re: Error Handler best practices

I've dressed it up a bit:

Private Sub AllSubsAllMods()
On Error GoTo HandleErr
'code
Exit_Here:
On Error Resume Next
Exit Sub
HandleErr:
Select Case Err.Number
Case Else
Dim fn As String
fn = Me.Form.Name
modHandler.Ermsg (fn)
Resume Exit_Here
End Select
End Sub

'modHandler
Public Sub Ermsg(fn)
Dim strErrMsg As String
Dim strSql As String
strErrMsg = fn & " -- Error Number " & Err.Number & ": " &
Err.Description
MsgBox strErrMsg
strSql = "INSERT INTO tblErrors ( [ErrMsg] ) VALUES (" & """" &
strErrMsg & """)"
DoCmd.SetWarnings False
DoCmd.RunSQL strSql
DoCmd.SetWarnings True
End Sub




"deko" <dje422@hotmail.com> wrote in message
news:337Cb.70105$0J6.61008@newssvr25.news.prodigy. com...[color=blue]
> Thanks... you may be getting me in over my head, but I'll see if I can[/color]
get[color=blue]
> that module to work in my mdb...
>
> for now, I've come up with this:
>
> Exit_Here:
> On Error Resume Next
> Exit Sub
> HandleErr:
> Select Case Err.Number
> Case Else
> Dim fn As String
> fn = Me.Form.Name
> modHandler.Ermsg (fn)
> Resume Exit_Here
> End Select
>
> Here is code for modHandler:
>
> Public Sub Ermsg (fn)
> MsgBox "Error Number " & Err.Number & ": " & Err.Description & vbCrLf[/color]
&[color=blue]
> fn
> End Sub
>
> the next step is putting this into every procedure in the database...
> perhaps there is a way to automate this... ?
>
>
> "(Pete Cresswell)" <x@y.z> wrote in message
> news:giiftvo5bc9jqrenpoinaeov7pf6freph4@4ax.com...[color=green]
> > RE/[color=darkred]
> > >I use this convention frequently:
> > >
> > >Exit_Here:
> > > Exit Sub
> > >HandleErr:
> > > Select Case Err.Number
> > > Case 3163
> > > Resume Next
> > > Case 3376
> > > Resume Next
> > > Case Else
> > > MsgBox "Error Number " & Err.Number & ": " &[/color][/color][/color]
Err.Description[color=blue][color=green][color=darkred]
> > > Resume Exit_Here
> > > End Select
> > >
> > >Is there a way to include the current procedure name on Case Else?
> > >
> > >perhaps something like this:
> > >
> > >Case Else
> > > MsgBox "Error Number " & Err.Number & ": " &[/color][/color][/color]
Err.Description[color=blue]
> &[color=green][color=darkred]
> > >vbCrLf & _
> > > Me.ProcedureName & Me.Form
> > > Resume Exit_Here
> > >End Select
> > >(note: "Me.ProcedureName" is pseudo code - I don't know if it's[/color][/color][/color]
possible[color=blue]
> to[color=green][color=darkred]
> > >get this...)
> > >
> > >How about offloading this to a module so I don't have to type it out[/color][/color]
> every[color=green][color=darkred]
> > >time:
> > >
> > >Case Else
> > > strP = Me!Procedure
> > > strF = Me.Form
> > > modErr.caseElse
> > >End Select
> > >
> > >thoughts ? suggestions ?
> > >
> > >Thanks in advance...
> > >[/color]
> >
> > Every routine I write is within the skeleton below.
> >
> > "DebugStackPush()", "DebugStackPop()", and "BugAlert()" are all in
> > a module I call "basBugAlert".
> >
> > The Push/Pop routines push the routine's name into an array/pop it out.
> >
> > "BugAlert" refers to the array to get a trace of where we've been
> > just before the error popped. It then displays a little error screen[/color][/color]
to[color=blue][color=green]
> > the user and logs the error and the trace in a .TXT file.
> >
> > The module is at the end of this note. If somebody can make it a[/color][/color]
little[color=blue][color=green]
> > better, I'd appreciate a copy of the improved code.
> >
> > If you're trying to compile it and the line breaks are making you crazy,[/color]
> post[color=green]
> > a reply and I'll email the .bas file to you.
> >
> > -----------------------------------------------
> > Whatever()
> > DebugStackPush mModulename & ": Whatever"
> > On Error GoTo Whatever_err
> >
> > ' PURPOSE: To do whatever
> > ' ACCEPTS:
> > ' RETURNS:
> > '
> > ' NOTES: 1).....
> >
> >
> > (code goes here...)
> >
> > Whatever_xit:
> > DebugStackPop
> > On Error Resume Next
> > (release pointers, close recordsets)
> > Exit Sub
> >
> > Whatever_err:
> > BugAlert True, ""
> > (optionally case out on Err if some errors are acceptable)
> > Resume Whatever_xit
> > ----------------------------------------------
> > Option Compare Database 'Use database order for string comparisons
> > Option Explicit
> >
> > ' This module contains the routines used to trap/log errors and
> > ' show the "bugAlert" screen.
> >
> > ' REQUIRES: 1) A table named "---------- Program Changes ----------" in[/color]
> the app[color=green]
> > '
> > ' 2) A global constant:
> > ' Global Const gIniGroupName = "TretsParms"
> > '
> > ' 3) Two forms:
> > ' frmBugAlertConcise
> > ' frmBugAlertVerbose
> > '
> > ' NOTES: 1) To avoid loops, most of these routines should be using[/color]
> their own[color=green]
> > own error trapping,
> > ' which would be limited to just showing message boxes - as[/color]
> opposed[color=green]
> > to potentially-recursive
> > ' calls to debugStackPush() and debugStackPop()
> >
> > Const mModuleName = "basBugAlert"
> >
> > Global Const gStackLimit = 50
> >
> > Const debugStackTotalSize = 52
> > Global gDebugStack(debugStackTotalSize)
> >
> > Global gStackPointer As Integer
> >
> > Global gErrorMessage As String 'For any calling[/color]
> routine[color=green]
> > that wants to trap the error message before bugAlert munches on it.
> > Global gErrorLocation As String 'Ditto above, but[/color]
> contains[color=green]
> > name of routine
> >
> > Private Declare Function GetComputerName_bal Lib "kernel32" Alias
> > "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
> > Private Declare Function GetUserName_bal Lib "advapi32.dll" Alias[/color]
> "GetUserNameA"[color=green]
> > (ByVal lpBuffer As String, nSize As Long) As Long
> > Private Declare Function GetPrivateProfileString Lib "kernel32" Alias
> > "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal[/color]
> lpKeyName[color=green]
> > As Any, ByVal lpDefault As String, ByVal lpReturnedString As String,[/color][/color]
ByVal[color=blue]
> nSize[color=green]
> > As Long, ByVal lpFileName As String) As Long
> > Sub bugAlert(ByVal theDisplaySwitch As Integer, ByVal[/color]
> theSupplementalMessage As[color=green]
> > String)
> >
> > ' PURPOSE: To log an error and, maybe, show an error screen to the user
> > ' ACCEPTS: - A boolean telling whether-or-not to show a screen to the[/color]
> user[color=green]
> > ' - Supplemental text to be added to the log entry and shown[/color][/color]
on[color=blue]
> the[color=green]
> > screen
> > ' USES: - An optional .INI file parm called "myErrorPath", which[/color][/color]
tells[color=blue]
> where[color=green]
> > to write the error
> > ' - An optional .INI file parm called "VerboseErrorDisplay"[/color][/color]
that[color=blue]
> tells[color=green]
> > us if we want
> > ' to show frmBugAlertVerbose
> > '
> > ' NOTES: 1) We are in error mode: anything could be happening.
> > ' Therefore error trapping is limited to a messagebox.
> > ' 2) We assume that the calling routine, after invoking this,[/color]
> will[color=green]
> > gracefully proceed
> > ' to it's "Exit" coding and pop the debug stack on the way[/color]
> out.[color=green]
> > ' 3) Note that out "On Error" statement isn't until *After*[/color]
> we've[color=green]
> > captured error info.
> > ' 4) Setting the display switch to False and suppling a[/color]
> supplemental[color=green]
> > message allows the programmer
> > ' to record things in the error log which did not result[/color][/color]
from[color=blue][color=green]
> > errors in the technical sense.
> > ' e.g. bugAlert, False, "This sentence gets written to the[/color]
> error[color=green]
> > log"
> > ' 5) If there is no path specified in the .INI file, we write[/color][/color]
to[color=blue]
> the[color=green]
> > root of C:
> >
> > 1001 Dim myErrorLine As Long
> > Dim myErrorNumber As Long
> > Dim myErrorMessage As String
> >
> > 1002 myErrorLine = Erl 'Capture relevant info ASAP
> > 1003 myErrorNumber = Err
> > 1004 myErrorMessage = Error$
> > 1005 gErrorMessage = Error$
> > 1006 gErrorLocation = gDebugStack(gStackPointer)
> >
> > 1007 On Error GoTo bugAlert_err
> > 1008 DoCmd.Echo True 'In case it was turned off[/color]
> elsewhere[color=green]
> >
> > Dim v As Variant
> > Dim X As Integer
> > Dim myMessage As String
> > Dim myTimeStamp As String
> > Dim i As Integer
> > Dim L As Long
> > Dim myErrorPath As String
> > Dim myHeaderLine As String
> > Dim myAppVersion As String
> > Dim myVerboseSw As Boolean
> >
> > Dim ParmValue As String
> >
> > Const cannotDoAtThisTime = 2486
> >
> > Dim skipLine As String
> >
> > 1010 skipLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & " "
> >
> > 1011 DoCmd.SetWarnings True
> >
> > 1020 ParmValue = String(255, 0)
> > 1021 L = GetPrivateProfileString(gIniGroupName, "ErrorLogPath",[/color]
> "{NotFound}",[color=green]
> > ParmValue, 255, SysCmd(acSysCmdIniFile))
> > 1022 If L And Left(ParmValue, 10) <> "{NotFound}" Then
> > 1023 myErrorPath = Left(ParmValue, L)
> > 1024 Else
> > 1025 myErrorPath = CurrentDb().Name
> > 1026 If Right(myErrorPath, 4) = ".mdb" Then
> > 1027 myErrorPath = Left(myErrorPath, Len(myErrorPath) - 4)
> > 1028 End If
> > 1029 myErrorPath = myErrorPath & ".Errors.txt"
> > 1030 End If
> >
> > 1040 ParmValue = String(255, 0)
> > 1041 L = GetPrivateProfileString(gIniGroupName, "VerboseErrorDisplay",
> > "{NotFound}", ParmValue, 255, SysCmd(acSysCmdIniFile))
> > 1042 If L And Left(ParmValue, 10) <> "{NotFound}" Then
> > 1043 If (Left(ParmValue, L) = "True") Or (Left(ParmValue, L) =[/color][/color]
"Yes")[color=blue]
> Then[color=green]
> > 1044 myVerboseSw = True
> > 1045 End If
> > 1046 End If
> >
> > 1049 myVerboseSw = True 'FORCE VERBOSE ERROR DISPLAY
> >
> > 1050 X = FreeFile
> > 1051 Open myErrorPath For Append As X
> >
> > 1060 Print #X,
> > "-----------------------------------------------------------------"
> >
> > 1070 myAppVersion = currentVersionGet_bal
> > 1071 myHeaderLine = VBA.Format$(Now, "mm/dd/yy hh:nn:ss") &[/color][/color]
myAppVersion[color=blue]
> & "[color=green]
> > Userid: " & windozeIdGet_bal() & " on " & computerNameGet_bal()
> >
> > 1080 Print #X, myHeaderLine
> >
> > 1090 If theDisplaySwitch = False Then
> > 1091 Print #X, "(ERROR SCREEN SUPPRESSED)"
> > 1092 End If
> >
> > 1100 Print #X, " Proc: " &[/color][/color]
gDebugStack(gStackPointer)[color=blue][color=green]
> >
> > 1101 If myErrorNumber <> 0 Then
> > 1102 If myErrorLine > 0 Then
> > 1103 Print #X, String(9, " ") & "Line " & VBA.Format$(myErrorLine,
> > "000000") & " " & VBA.Format$(myErrorNumber, "0000") & ": " &[/color]
> myErrorMessage[color=green]
> > 1104 Else
> > 1105 Print #X, String(13, " ") & VBA.Format$(myErrorNumber,[/color][/color]
"0000")[color=blue]
> & ": "[color=green]
> > & myErrorMessage
> > 1109 End If
> > 1110 Else
> > 1111 If myErrorLine > 0 Then
> > 1112 Print #X, String(9, " ") & "Line " & VBA.Format$(myErrorLine,
> > "000000") & ": "
> > 1113 Else
> > 1114 Print #X, String(13, " ")
> > 1115 End If
> > 1119 End If
> >
> > 1120 If theSupplementalMessage <> "" Then
> > 1121 Print #X, Space$(19) & theSupplementalMessage
> > 1122 End If
> >
> > 1130 Print #X, ""
> >
> > 1140 If gStackPointer > 1 Then
> > 1141 For i = 0 To gStackLimit
> > 1142 If gDebugStack(i) <> "" Then
> > 1143 If i = gStackPointer Then
> > 1144 Print #X, Space$(9) & " " & Format(i, "00") &[/color]
> ">>" &[color=green]
> > gDebugStack(i)
> > 1145 Else
> > 1146 If i = 1 Then
> > 1150 Print #X, Space$(9) & "CallOuts: " & Format(i, "00")[/color][/color]
&[color=blue]
> " "[color=green]
> > & gDebugStack(i)
> > 1151 Else
> > 1152 Print #X, Space$(9) & " " & Format(i, "00")[/color][/color]
&[color=blue]
> " "[color=green]
> > & gDebugStack(i)
> > 1153 End If
> > 1154 End If
> > 1155 End If
> > 1156 Next i
> > 1157 End If
> > 1158 Close #X
> >
> > 1170 If theDisplaySwitch = True Then
> > 1171 If myVerboseSw = True Then
> > 1172 If myErrorLine > 0 Then
> > 1173 myMessage = " " & "... at line " & Str(myErrorLine) & "[/color]
> in " &[color=green]
> > Chr$(34) & gDebugStack(gStackPointer) & Chr$(34)
> > 1174 Else
> > 1175 myMessage = " " & "in " & Chr$(34) &[/color]
> gDebugStack(gStackPointer)[color=green]
> > & Chr$(34)
> > 1176 End If
> >
> > 1180 myMessage = myMessage & skipLine & "Error# " &[/color]
> Str(myErrorNumber) &[color=green]
> > ": " & myErrorMessage
> > 1181 myMessage = myMessage & skipLine & theSupplementalMessage
> > 1182 DoCmd.OpenForm "frmBugAlertVerbose", , , , , , myMessage
> > 1183 Else
> > 1184 DoCmd.OpenForm "frmBugAlertConcise", , , , , , myErrorPath
> > 1185 End If
> > 1999 End If
> >
> > bugAlert_xit:
> > On Error Resume Next
> > Close #X
> > Exit Sub
> >
> > bugAlert_err:
> > Select Case Err
> > Case cannotDoAtThisTime
> > 'Do nothing: There is probably a print dialog active, which[/color]
> prevents[color=green]
> > opening the bugALert screen.
> > 'Error has, however been writen to the error log...
> >
> > Case Else
> > MsgBox "bugAlert() failed at line " & Str(Erl) & ", Error " &[/color]
> Str(Err) &[color=green]
> > ": " & Error$ & vbCrLf & "StackPointer=" & Val(gStackPointer) & vbCrLf &[/color]
> vbCrLf[color=green]
> > & "Original error Info:" & vbCrLf & "Error " & Str(myErrorNumber) & " at[/color]
> line "[color=green]
> > & Str(myErrorLine) & ": " & myErrorMessage & vbCrLf &[/color]
> theSupplementalMessage,[color=green]
> > 48, "Error In Error Handler"
> > stackFlush
> > End Select
> > Resume bugAlert_xit
> > End Sub
> > Sub stackFlush()
> >
> > ' PURPOSE: Flush the debug stack to the log file in case we find it is
> > overloaded
> > ' ACCEPTS: - A boolean telling whether-or-not to show a screen to the[/color]
> user[color=green]
> > ' - Supplemental text to be added to the log entry and shown[/color][/color]
on[color=blue]
> the[color=green]
> > screen
> >
> > 1010 Dim myErrorLine As Long
> > Dim myErrorNumber As Long
> > Dim myErrorMessage As String
> >
> > 1011 myErrorLine = Erl 'Capture relevant info ASAP
> > 1012 myErrorNumber = Err
> > 1013 myErrorMessage = Error$
> >
> > 1014 On Error GoTo stackFlush_err
> >
> > Dim X As Integer
> > Dim i As Integer
> > Dim L As Long
> > Dim myErrorPath As String
> > Dim myHeaderLine As String
> > Dim myAppVersion As String
> >
> > Dim ParmValue As String
> >
> > Const myOptionGroup = "ProgramParms"
> > Const cannotDoAtThisTime = 2486
> >
> > Dim skipLine As String
> > 1020 skipLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & " "
> >
> > 1021 DoCmd.SetWarnings True
> >
> > 1030 ParmValue = String(255, 0)
> > 1031 L = GetPrivateProfileString(myOptionGroup, "ErrorPath",[/color]
> "{NotFound}",[color=green]
> > ParmValue, 255, SysCmd(acSysCmdIniFile))
> > 1032 If L And Left(ParmValue, 10) <> "{NotFound}" Then
> > 1033 myErrorPath = Left(ParmValue, L)
> > 1034 Else
> > 1035 myErrorPath = "C:\Error.txt"
> > 1036 End If
> >
> > 1050 X = FreeFile
> > 1051 Open myErrorPath For Append As X
> >
> > 1060 Print #X,
> > "-----------------------------------------------------------------"
> > 1061 Print #X, "<================= STACK FLUSH
> > =================================>"
> >
> > 1071 myHeaderLine = VBA.Format$(Now, "mm/dd/yy hh:nn:ss") & " Userid: "[/color][/color]
&[color=blue][color=green]
> > CurrentUser() & " on " & computerNameGet_bal()
> >
> > 1080 Print #X, myHeaderLine
> > 1100 Print #X, " Proc: " &[/color][/color]
gDebugStack(gStackPointer)[color=blue][color=green]
> > 1130 Print #X, ""
> >
> > 1140 If gStackPointer > 1 Then
> > 1141 For i = 0 To gStackLimit
> > 1142 If gDebugStack(i) <> "" Then
> > 1143 If i = gStackPointer Then
> > 1144 Print #X, Space$(9) & " " & Format(i, "00") &[/color]
> ">>" &[color=green]
> > gDebugStack(i)
> > 1145 Else
> > 1146 If i = 1 Then
> > 1150 Print #X, Space$(9) & "CallOuts: " & Format(i, "00")[/color][/color]
&[color=blue]
> " "[color=green]
> > & gDebugStack(i)
> > 1151 Else
> > 1152 Print #X, Space$(9) & " " & Format(i, "00")[/color][/color]
&[color=blue]
> " "[color=green]
> > & gDebugStack(i)
> > 1153 End If
> > 1154 End If
> > 1155 End If
> > 1156 Next i
> > 1157 End If
> > 1999 Close #X
> >
> > stackFlush_xit:
> > On Error Resume Next
> > Close #X
> > Exit Sub
> >
> > stackFlush_err:
> > Select Case Err
> > Case cannotDoAtThisTime
> > 'Do nothing: There is probably a print dialog active, which[/color]
> prevents[color=green]
> > opening the stackFlush screen.
> > 'Error has, however been writen to the error log...
> >
> > Case Else
> > MsgBox "stackFlush() failed at line " & Str(Erl) & ", Error " &[/color]
> Str(Err)[color=green]
> > & ": " & Error$ & vbCrLf & "StackPointer=" & Val(gStackPointer) & vbCrLf[/color][/color]
&[color=blue][color=green]
> > vbCrLf & "Original error Info:" & vbCrLf & "Error " & Str(myErrorNumber)[/color][/color]
&[color=blue]
> " at[color=green]
> > line " & Str(myErrorLine) & ": " & myErrorMessage, 48, "Error In Error[/color]
> Handler"[color=green]
> > End Select
> > Resume stackFlush_xit
> > End Sub
> > Sub aaTestBugAlert()
> > debugStackPush mModuleName & ": aaTestBugAlert"
> > On Error GoTo aaTestBugAlert_err
> >
> > ' PURPOSE: To supply a model for using the BugAlert routines and to demo[/color]
> the[color=green]
> > routines
> > '
> > ' NOTES: 1) Fire up a Debug window and type "aaTestBugAlert"
> >
> > DoCmd.OpenForm "frmNon-Existant"
> >
> > aaTestBugAlert_xit:
> > debugStackPop
> > On Error Resume Next
> > Exit Sub
> >
> > aaTestBugAlert_err:
> > ' bugAlert False, "This is the supplemental text...."
> > bugAlert True, "This is the supplemental text...."
> > Resume aaTestBugAlert_xit
> > End Sub
> > Sub debugStackPop()
> > On Error GoTo debugStackPop_err
> >
> > ' PURPOSE: To pop the last procedure name off the top of the debug stack
> >
> > Dim i As Integer
> >
> > If gStackPointer <= gStackLimit Then
> > gDebugStack(gStackPointer) = ""
> > End If
> >
> > gStackPointer = gStackPointer - 1
> >
> > If gStackPointer < 0 Then
> > gStackPointer = 0
> > End If
> >
> > debugStackPop_xit:
> > On Error Resume Next
> > Exit Sub
> >
> > debugStackPop_err:
> > MsgBox "debugStackPop() failed. Error " & Str(Err) & ": " & Error$,[/color][/color]
48,[color=blue]
> "Error[color=green]
> > In Error Handler"
> > Resume debugStackPop_xit
> > End Sub
> > Function debugStackPrint()
> > On Error GoTo debugStackPrint_err
> >
> > Dim i As Integer
> >
> > DoCmd.Hourglass True
> > Debug.Print "-------- Begin Debug Stack ---------"
> >
> > For i = 1 To gStackPointer
> > Debug.Print VBA.Format$(i, "00") & ": " & gDebugStack(i)
> > Next i
> >
> > Debug.Print "---------- End Debug Stack ---------"
> > DoCmd.Hourglass False
> >
> > debugStackPrint_xit:
> > On Error Resume Next
> > Exit Function
> >
> > debugStackPrint_err:
> > MsgBox "debugStackPrint() failed. Error " & Str(Err) & ": " & Error$,[/color]
> 48,[color=green]
> > "Error In Error Handler"
> > Resume debugStackPrint_xit
> > End Function
> > Sub debugStackPush(ByVal theProcedureName As String)
> > On Error GoTo debugStackPush_err
> >
> > ' PURPOSE: To push a procedure name into the debug stack
> > ' ACCEPTS: The procedure name
> > Dim i As Integer
> >
> > gStackPointer = gStackPointer + 1
> >
> > If gStackPointer <= gStackLimit Then
> > gDebugStack(gStackPointer) = theProcedureName
> > Else
> > gDebugStack(gStackLimit + 2) = theProcedureName
> > End If
> >
> > debugStackPush_xit:
> > On Error Resume Next
> > Exit Sub
> >
> > debugStackPush_err:
> > MsgBox "debugStackPush() failed. Error " & Str(Err) & ": " & Error$,[/color][/color]
48,[color=blue][color=green]
> > "Error In Error Handler"
> > Resume debugStackPush_err
> > End Sub
> > Private Function computerNameGet_bal() As String
> > On Error GoTo computerNameGet_bal_err
> >
> > ' PURPOSE: To extract the name of the user's PC from via Windows API[/color]
> instead of[color=green]
> > environment variables
> > ' RETURNS: Name of user's PC or a blank string
> >
> > Dim L As Long
> > Dim lpBuffer As String * 255
> > Dim myComputerName As String
> >
> > L = GetComputerName_bal(lpBuffer, 255)
> > myComputerName = stripNulls_bal(lpBuffer)
> >
> > computerNameGet_bal = myComputerName
> >
> > computerNameGet_bal_xit:
> > On Error Resume Next
> > Exit Function
> >
> > computerNameGet_bal_err:
> > MsgBox "computerNameGet_bal() failed. Error " & Str(Err) & ": " &[/color]
> Error$, 48,[color=green]
> > "Error In Error Handler"
> > Resume computerNameGet_bal_xit
> > End Function
> > Private Function stripNulls_bal(theOriginalString As String)
> > On Error GoTo stripNulls_bal_err
> >
> > If InStr(1, theOriginalString, Chr(0), vbTextCompare) Then
> > theOriginalString = Mid(theOriginalString, 1,[/color]
> InStr(theOriginalString,[color=green]
> > Chr(0)) - 1)
> > End If
> >
> > stripNulls_bal = theOriginalString
> >
> > stripNulls_bal_xit:
> > On Error Resume Next
> > Exit Function
> >
> > stripNulls_bal_err:
> > MsgBox "stipNulls() failed. Error " & Str(Err) & ": " & Error$, 48,[/color]
> "Error In[color=green]
> > Error Handler"
> > Resume stripNulls_bal_xit
> > End Function
> > Private Function currentVersionGet_bal() As String
> > 1001 On Error GoTo currentVersionGet_bal_err
> >
> > ' PURPOSE: To retrieve the current version of the app
> > ' RETURNS: Current version of the app as a formatted number. e.g.[/color]
> "5.31"[color=green]
> > ' USES: A special application-resident table named "----------[/color][/color]
Program[color=blue][color=green]
> > Changes ----------"
> > '
> > ' NOTES: 1) The table's name is designed to float it to the top of the[/color]
> table[color=green]
> > list and call attention
> > ' to the fact that is something out-of-the-ordinary[/color][/color]
table-wise[color=blue][color=green]
> >
> > 1010 Dim myRS As DAO.Recordset
> >
> > Static myCurrentVersion As String
> >
> > 1060 If Len(myCurrentVersion) = 0 Then
> > 1160 Set myRS = CurrentDb().OpenRecordset("SELECT Max([----------[/color]
> Program[color=green]
> > Changes ----------].versionNumber) AS MaxOfversionNumber FROM[/color][/color]
[----------[color=blue][color=green]
> > Program Changes ----------];", dbOpenSnapshot)
> > 1180 myCurrentVersion = "v" & VBA.Format$(Nz(myRS!MaxOfversionNumber,
> > "0.00"))
> > 1240 End If
> >
> > 1999 currentVersionGet_bal = myCurrentVersion
> >
> > currentVersionGet_bal_xit:
> > On Error Resume Next
> > myRS.Close
> > Set myRS = Nothing
> > Exit Function
> >
> > currentVersionGet_bal_err:
> > MsgBox "currentVersionGet() failed at line " & Str(Erl) & ", Error " &[/color]
> Str(Err)[color=green]
> > & ": " & Error$, 48, "Error In Error Handler"
> > Resume currentVersionGet_bal_xit
> > End Function
> > Sub stackClear()
> >
> > ' PURPOSE: To clear the debug stack. Intended for use while debugging.
> >
> > Dim i As Integer
> >
> > If gStackPointer > 1 Then
> > For i = 0 To gStackLimit
> > If gDebugStack(i) <> "" Then
> > gDebugStack(i) = ""
> > End If
> > Next i
> > End If
> >
> > gStackPointer = 0
> >
> > stackClear_xit:
> > On Error Resume Next
> > Exit Sub
> >
> > stackClear_err:
> > Resume stackClear_xit
> > End Sub
> > Private Function windozeIdGet_bal()
> > On Error GoTo windozeIdGet_bal_err
> >
> > ' PURPOSE: To get the current Windows UserID
> > ' RETURNS: ID or error message
> >
> > Dim myBuffer As String * 255
> > Dim myUserName As String
> >
> > GetUserName_bal myBuffer, Len(myBuffer) 'Get[/color]
> the[color=green]
> > user name
> > myUserName = Left(Trim(myBuffer), InStr(myBuffer, Chr(0)) - 1)[/color][/color]
'Trim[color=blue]
> excess[color=green]
> > characters
> >
> > If Len(myUserName) > 0 Then
> > windozeIdGet_bal = myUserName
> > Else
> > windozeIdGet_bal "windozeIdGet_bal() Unable to get Windows UserID"
> > End If
> >
> > windozeIdGet_bal_xit:
> > On Error Resume Next
> > Exit Function
> >
> > windozeIdGet_bal_err:
> > MsgBox "stipNulls() failed. Error " & Str(Err) & ": " & Error$, 48,[/color]
> "Error In[color=green]
> > Error Handler"
> > Resume windozeIdGet_bal_xit
> > End Function
> > ----------------------------------------------
> > --
> > PeteCresswell
> >[/color]
>
>
>[/color]

re: Error Handler best practices

David,
It's not in his error handler it's in the cleanup code just before the
procedure exit point.

Terry

"David W. Fenton" <dXXXfenton@bway.net.invalid> wrote in message
news:944E96C2Cdfentonbwaynetinvali@24.168.128.74.. .[color=blue]
> Matt@NoSpam.com (Matthew Sullivan) wrote in
> <lkmftvcnohk4jskpsii7g70419snl22mqb@4ax.com>:
>[color=green]
> >You might want an "On Error Resume Next" as the first thing in
> >your Exit section.
> >
> >Exit_Here:
> > On Error Resume Next
> > 'do some stuff here
> > Exit Sub
> >
> >Reason: if an error gets raised in the Exit section, your
> >ErrorHandler will go into an infinite loop.[/color]
>
> Er, I've never written a single error handler with that in it, nor
> ever seen one in any of the Access books I've used, and I've never
> encountered an error in an error handler. Of course, the only thing
> I ever do in an error handler is to display an error message and
> redirect to the appropriate location in code.
>
> --
> David W. Fenton http://www.bway.net/~dfenton
> dfenton at bway dot net http://www.bway.net/~dfassoc[/color]

re: Error Handler best practices

Perhaps I can put a call to a Function in the On Error event of each form:

= modHandler.LogErr (Me.Form.Name)

Will that work?

shouldn't that trap all errors from any sub within the form's module? (much
easier than adding handler code to every sub in the entire mdb!)

BUT...

how to deal with stuff I want to trap? If I put something like the below
code in modHandler.LogErr, shouldn't that let me trap a particular error in
a particular form? But what if I want to run different code in *different
subs* for the same error in the same form module? Can the On Error event of
the form be overridden?

Or am I missing something and totally on the wrong track?

Public Function LogErr (fn)
Dim strErrMsg As String
Dim strSql As String
Exit_Here:
On Error Resume Next
Exit Function
Select Case Err.Number
Case 94
If fn = "frm1" Then
run code stuff specific to error 94 in *ALL SUBS* in frm1
Resume Exit_Here
End If
If fn = "frm2"
run code specific to error 94 in *ALL SUBS* in frm2
Resume Exit_Here
End If
'... and so on for each form in question
Case Else
Resume Exit_Here
End Select
strErrMsg = fn & " -- Error Number " & Err.Number & ": " &
Err.Description
MsgBox strErrMsg
strSql = "INSERT INTO tblErrors ( [ErrMsg] ) VALUES (" & """" &
strErrMsg & """)"
DoCmd.SetWarnings False
DoCmd.RunSQL strSql
DoCmd.SetWarnings True
End Function


"deko" <dje422@hotmail.com> wrote in message
news:IsNBb.69418$i05.6435@newssvr25.news.prodigy.c om...[color=blue]
> I use this convention frequently:
>
> Exit_Here:
> Exit Sub
> HandleErr:
> Select Case Err.Number
> Case 3163
> Resume Next
> Case 3376
> Resume Next
> Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description
> Resume Exit_Here
> End Select
>
> Is there a way to include the current procedure name on Case Else?
>
> perhaps something like this:
>
> Case Else
> MsgBox "Error Number " & Err.Number & ": " & Err.Description &
> vbCrLf & _
> Me.ProcedureName & Me.Form
> Resume Exit_Here
> End Select
> (note: "Me.ProcedureName" is pseudo code - I don't know if it's possible[/color]
to[color=blue]
> get this...)
>
> How about offloading this to a module so I don't have to type it out every
> time:
>
> Case Else
> strP = Me!Procedure
> strF = Me.Form
> modErr.caseElse
> End Select
>
> thoughts ? suggestions ?
>
> Thanks in advance...
>
>[/color]

re: Error Handler best practices

so far, I cannot get this idea to work...

"deko" <dje422@hotmail.com> wrote in message
news:QsvCb.70733$Uy.39904@newssvr25.news.prodigy.c om...[color=blue]
> Perhaps I can put a call to a Function in the On Error event of each form:
>
> = modHandler.LogErr (Me.Form.Name)
>
> Will that work?
>
> shouldn't that trap all errors from any sub within the form's module?[/color]
(much[color=blue]
> easier than adding handler code to every sub in the entire mdb!)
>
> BUT...
>
> how to deal with stuff I want to trap? If I put something like the below
> code in modHandler.LogErr, shouldn't that let me trap a particular error[/color]
in[color=blue]
> a particular form? But what if I want to run different code in *different
> subs* for the same error in the same form module? Can the On Error event[/color]
of[color=blue]
> the form be overridden?
>
> Or am I missing something and totally on the wrong track?
>
> Public Function LogErr (fn)
> Dim strErrMsg As String
> Dim strSql As String
> Exit_Here:
> On Error Resume Next
> Exit Function
> Select Case Err.Number
> Case 94
> If fn = "frm1" Then
> run code stuff specific to error 94 in *ALL SUBS* in frm1
> Resume Exit_Here
> End If
> If fn = "frm2"
> run code specific to error 94 in *ALL SUBS* in frm2
> Resume Exit_Here
> End If
> '... and so on for each form in question
> Case Else
> Resume Exit_Here
> End Select
> strErrMsg = fn & " -- Error Number " & Err.Number & ": " &
> Err.Description
> MsgBox strErrMsg
> strSql = "INSERT INTO tblErrors ( [ErrMsg] ) VALUES (" & """" &
> strErrMsg & """)"
> DoCmd.SetWarnings False
> DoCmd.RunSQL strSql
> DoCmd.SetWarnings True
> End Function
>
>
> "deko" <dje422@hotmail.com> wrote in message
> news:IsNBb.69418$i05.6435@newssvr25.news.prodigy.c om...[color=green]
> > I use this convention frequently:
> >
> > Exit_Here:
> > Exit Sub
> > HandleErr:
> > Select Case Err.Number
> > Case 3163
> > Resume Next
> > Case 3376
> > Resume Next
> > Case Else
> > MsgBox "Error Number " & Err.Number & ": " & Err.Description
> > Resume Exit_Here
> > End Select
> >
> > Is there a way to include the current procedure name on Case Else?
> >
> > perhaps something like this:
> >
> > Case Else
> > MsgBox "Error Number " & Err.Number & ": " & Err.Description[/color][/color]
&[color=blue][color=green]
> > vbCrLf & _
> > Me.ProcedureName & Me.Form
> > Resume Exit_Here
> > End Select
> > (note: "Me.ProcedureName" is pseudo code - I don't know if it's possible[/color]
> to[color=green]
> > get this...)
> >
> > How about offloading this to a module so I don't have to type it out[/color][/color]
every[color=blue][color=green]
> > time:
> >
> > Case Else
> > strP = Me!Procedure
> > strF = Me.Form
> > modErr.caseElse
> > End Select
> >
> > thoughts ? suggestions ?
> >
> > Thanks in advance...
> >
> >[/color]
>
>
>[/color]