Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
This code is a class to handle errors in visual ba...
Author:
David Combs
E-mail:
Click to e-mail author
Submitted:
4/11/2001
Version:
VB4
Compatibility:
VB4, VB5, VB6
Category:
ActiveX
Views:
10895
This code is a class to handle errors in visual basic very easily. It even has a logging option to log the errors to a specified location. is compatible with ADO and RDO, even logs the errors collection.
Declarations:
Option Explicit ' API Function to get the user name Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _ (ByVal v_strBuffer As String, _ ByRef r_lngSize As Long) As Long ' API Function to get the computer name Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _ (ByVal v_strBuffer As String, _ ByRef r_lngSize As Long) As Long Const mc_lngSize As Long = 255 ' used when retrieveing the user and computer names Const mc_strEmpty As String = "" ' used to check for empty strings Private m_strFilePath As String ' path to save the log Private m_blnLoggingOn As Boolean ' turn logging on or off Private m_strUserName As String ' store the user name for logging purposes Private m_strComputerName As String ' the name of the computer the error occurred on Private m_objErrADO As Object ' object used to store the ADO Errors collection Private m_objErrRDO As Object ' object used to store the RDO Errors collection
Code:
Public Property Let blnLoggingOn(ByVal v_blnLoggingOn As Boolean) m_blnLoggingOn = v_blnLoggingOn End Property Private Sub Class_Initialize() ' PURPOSE: sets the defaults of the log file path and user name. The computer name is not an ' option. ' INPUTS : None ' ASSUMES: log file path and user name are defaulted ' RETURNS: None ' EFFECTS: None Const c_strLogFileName As String = "\ErrorLog.txt" m_strFilePath = App.Path & c_strLogFileName m_strUserName = strWindowsLogon() m_strComputerName = strComputerName() End Sub Private Sub Class_Terminate() ' PURPOSE: To clear all varibles ' INPUTS : None ' ASSUMES: None ' RETURNS: None ' EFFECTS: None m_strFilePath = mc_strEmpty m_strUserName = mc_strEmpty m_strComputerName = mc_strEmpty End Sub Private Sub m_CheckErrors(ByVal v_objError As VBA.ErrObject, _ ByVal v_strReportedBy As String) ' PURPOSE: To check all the Error Objects and log them to a file ' INPUTS : None ' ASSUMES: None ' RETURNS: None ' EFFECTS: None Dim objItem As Object Call m_LogError(v_objError, v_strReportedBy) ' log the initial error ' Check the value of m_objErrADO to see if it has been set or not If Not m_objErrADO Is Nothing Then For Each objItem In m_objErrADO Call m_LogError(objItem, v_strReportedBy) Next End If ' Check the value of m_objErrRDO to see if it has been set or not If Not m_objErrRDO Is Nothing Then For Each objItem In m_objErrRDO Call m_LogError(objItem, v_strReportedBy) Next End If End Sub Private Sub m_LogError(ByVal v_objError As Object, _ ByVal v_strReportedBy As String) ' PURPOSE: Writes the error to a log file the user specifies or the application folder ' INPUTS : v_objError - the current error that has occurred ' v_strReportedBy - what procedure reported the error ' ASSUMES: None ' RETURNS: None ' EFFECTS: None Const c_strDelimiter As String = vbTab Dim intLogFile As Integer If CLng(v_objError.Number) <> 0 Then intLogFile = FreeFile Open m_strFilePath For Append Access Write As intLogFile ' Write the error to the file Print #intLogFile, , CStr(Format(Now(), "mm/dd/yyyy hh:nn:ss")); _ c_strDelimiter; _ App.EXEName; _ c_strDelimiter; _ v_objError.Number; _ c_strDelimiter; _ v_strReportedBy; _ c_strDelimiter; _ v_objError.Source; _ c_strDelimiter; _ v_objError.Description; _ c_strDelimiter; _ m_strUserName; _ c_strDelimiter; _ m_strComputerName Close #intLogFile End If End Sub Private Function m_strMakeCallPath(ByVal v_strProcSig As String, _ ByVal v_strErrorSource As String) As String ' PURPOSE: To create the path of the error as it is bubbled up the call stack ' INPUTS : v_strProcSig - the name of the procedure where the error is raised ' v_strErrorSource - the name of the error source ' ASSUMES: None ' RETURNS: The call path of the error ' EFFECTS: None Const c_strCallPathSeparator As String = " | " m_strMakeCallPath = v_strProcSig & c_strCallPathSeparator & v_strErrorSource End Function Public Property Set objErrorsADO(ByVal v_objErrors As Object) Set m_objErrADO = v_objErrors End Property Public Property Set objErrorsRDO(ByVal v_objErrors As Object) Set m_objErrRDO = v_objErrors End Property Public Sub RaiseError(ByVal v_objErr As VBA.ErrObject, _ ByVal v_strProcSig As String) ' PURPOSE: allows the user to raise an error when there is no error handling routine in the ' procedure from which this procedure was called ' INPUTS : v_objError - the object that holds the current error information ' v_strProcSig - name of the procedure where the error occurred ' ASSUMES: None ' RETURNS: None ' EFFECTS: None v_objErr.Raise v_objErr.Number, _ m_strMakeCallPath(v_strProcSig, v_objErr.Source), _ v_objErr.Description End Sub Public Sub ShowError(ByVal v_objError As VBA.ErrObject, _ ByVal v_strReportedBy As String) ' PURPOSE: Displays the error to the user and if logging is turned on, it logs the error to ' a file ' INPUTS : v_objError - the object that holds the current error information ' v_strReportedBy - what procedure reported the error ' ASSUMES: None ' RETURNS: None ' EFFECTS: None Call MsgBox("Error: " & v_objError.Number & vbCrLf & _ "Reported By: " & v_strReportedBy & vbCrLf & _ "Source: " & v_objError.Source & vbCrLf & _ "Description: " & v_objError.Description, vbInformation, "Error") If m_blnLoggingOn Then Call m_CheckErrors(v_objError, v_strReportedBy) End Sub Public Function strComputerName() As String ' PURPOSE: will get the computer name ' INPUTS : None ' ASSUMES: None ' RETURNS: the computer name ' EFFECTS: None Dim strString As String Dim lngSize As Long Dim lngComputerName As Long strString = String$(mc_lngSize, vbNullChar) lngSize = mc_lngSize lngComputerName = GetComputerName(strString, lngSize) strComputerName = Left$(strString, lngSize) End Function Public Property Let strLogPath(ByVal v_strPath As String) If v_strPath <> mc_strEmpty Then m_strFilePath = v_strPath End Property Public Property Let strUserName(ByVal v_strUser As String) m_strUserName = v_strUser End Property Public Function strWindowsLogon() As String ' PURPOSE: will get the Windows logon id ' INPUTS : None ' ASSUMES: None ' RETURNS: the Windows logon id ' EFFECTS: None Dim lngUserName As Long Dim strString As String Dim lngSize As Long strString = String$(mc_lngSize, vbNullChar) lngSize = mc_lngSize lngUserName = GetUserName(strString, lngSize) strWindowsLogon = Left$(strString, lngSize - 1) End Function
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement