home *** CD-ROM | disk | FTP | other *** search
Visual Basic class definition | 1997-07-26 | 3.3 KB | 92 lines |
- VERSION 1.0 CLASS
- BEGIN
- MultiUse = -1 'True
- END
- Attribute VB_Name = "ErrorHandler"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = True
- Attribute VB_PredeclaredId = False
- Attribute VB_Exposed = False
- Option Explicit
-
- Public Function FatalError(ErrorNum As Integer, Source As String)
- Attribute FatalError.VB_UserMemId = 0
-
- '***When calling this sub from a form use this syntax: _
- If not oError(Err.Number, 'Name of Form and Sub' in quotes) Then Resume
-
- Dim sMsg As String 'Holds the message to be displayed in a message box(PC)
-
- Select Case ErrorNum
- Case 3196, 3356, 3418
- sMsg = "The Database is in use by another user and cannot be modified. "
- GoTo dbError_RetryCancel
- Case 3024, 3006
- sMsg = "Database Not Found or is Locked by another user. Application will terminate."
- GoTo dbError_Fatal
- Case 3008, 3009, 3189, 3211, 3212, 3261, 3262
- sMsg = "The record or table is in use and cannot be edited. Changes will not be saved."
- GoTo dbError_RetryCancel
- Case 3014, 3018, 3037
- sMsg = "The record or table you are trying to connect with is corrupt. Please contact tech support"
- GoTo dbError_Fatal
- Case 3021
- sMsg = "There are no records matching the selected criteria"
- GoTo dbError_RetryCancel
- Case 3022
- sMsg = "A duplicate value was found. Please edit first entry rather than create a new entry"
- GoTo dbError_NonFatal
- Case 3058, 3314, 3315
- sMsg = "Please include all required information."
- GoTo dbError_NonFatal
- Case 3070, 3078, 3177, 3184, 3242, 3340
- If Source = "MDIMain" Then
- sMsg = "Table in the database is not found or corrupt. The application will terminate"
- Else
- sMsg = "Table or Query in the database is not found or corrupt."
- End If
- GoTo dbError_Fatal
- Case 3044
- sMsg = ErrorNum & " " & Err.Description & " The application will terminate."
- GoTo dbError_Fatal
- Case Else
- sMsg = ErrorNum & " " & Err.Description & vbCrLf & "An unknown error has occurred. Please notify tech support"
- GoTo dbError_Fatal
- End Select
- Exit Function
-
- dbError_RetryCancel:
- Select Case MsgBox(sMsg & vbCrLf & Source, vbRetryCancel)
- Case vbRetry
- FatalError = False
- Case vbCancel
- FatalError = True
- GoTo Exit_FatalError
- End Select
-
- dbError_Fatal:
- MsgBox sMsg & vbCrLf & Source
- FatalError = True
- GoTo Exit_FatalError
-
- dbError_NonFatal:
- MsgBox sMsg & vbCrLf & Source
- FatalError = False
- GoTo Exit_FatalError
-
- Exit_FatalError:
-
- Call LogError(ErrorNum, Source)
-
- End Function
-
- Private Sub LogError(ErrorNum As Integer, Source As String)
-
- Open App.Path & "\Error.log" For Append As #1
- Seek #1, (LOF(1) + 1)
- Print #1, ErrorNum & " Source: " & Source; Tab(15); Err.Description; Tab(25); Format(Now(), "dddd mm/dd/yyyy") _
- ; Tab(49); Format(Now(), "h:mmam/pm");
- Close #1
-
- End Sub
-