VB icon

Error Handler Document

Email
Submitted on: 1/2/2015 8:30:00 AM
By: WalkerBro (from psc cd)  
Level: Not Given
User Rating: By 103 Users
Compatibility: VB 5.0, VB 6.0
Views: 1002
 
     This code pastes into a Module that Create (if not exists) a MDB to record the errors that occur in your application.
 

Windows API/Global Declarations:

Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
'**************************************
'Windows API/Global Declarations for :Error Handler Document
'**************************************
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Error Handler Document
' Description:This code pastes into a Module that Create (if not exists) a MDB to record the errors that occur in your application.
' By: WalkerBro (from psc cd)
'
' Inputs:Needs (DatabaseName, Date, Err.Number, Err.Description, PrivateNotes, Optional(User))
Load in "References" the "Microsoft DAO 3.51 Object Library"
'
' Returns:True or False if it was succesful.
'
' Assumes:Basic Error handling information.
'
' Side Effects:No known side effects.
'**************************************

'* Created by Walker Brother (tm)
'* web page : http://www.walkerbro.8m.com
'* e-mail: info@walkerbro.8m.com
'* This Module Logs the Errors your application may incounter into a MDB, if the MDB
'* does not exist the it Creates it.
'* It Creates a passworded MDB to stop other accessing your errors, you then can make
'* a frontend to read your errors.
'* Table Name : ErrList
'* Field Name : ErrDate, ErrDes, ErrNum, ErrNotes, ErrUser '* 'Usage 
'* Error_Handler:
'* Select Case Error_Handler_Doc("Name.mdb", Now, 123, "Description", "Notes")
'* Case "True" 
'* Case "False"
'* End Select
'* Load in "References" the "Microsoft DAO 3.51 Object Library"
Dim NewDB As Database
Dim ExistDB As Database
Dim ExistRS As Recordset
Public Function Error_Handler_Doc(ByVal ErrMDB As String, ErrDate As Date, ErrNum As Long, ErrDes As String, ErrNote As String, Optional ErrUser As String) As Boolean
Select Case Error_Handler_MDB(ErrMDB)
Case "False"
If Error_Handler_Create(ErrMDB, "!@#$") = False Then
Error_Handler_Doc = False
Exit Function
End If
End Select
Set ExistDB = OpenDatabase("C:\Program Files\Common Files\Walker Brothers\ErrorHandler\" & ErrMDB, False, False, ";pwd=!@#$")
Set ExistRS = ExistDB.OpenRecordset("ErrList", dbOpenDynaset)
ExistRS.AddNew
ExistRS.Fields!ErrNum = ErrNum & ""
ExistRS.Fields!ErrDate = ErrDate & ""
ExistRS.Fields!ErrDes = ErrDes & ""
ExistRS.Fields!ErrNote = ErrNote & ""
ExistRS.Fields!ErrUser = ErrUser & ""
ExistRS.Update
ExistRS.Close
ExistDB.Close
Set ExistRS = Nothing
Set ExistDB = Nothing
Error_Handler_Doc = True
End Function
Public Function Error_Handler_MDB(ByVal ErrMDB As String) As Boolean
On Error Resume Next
Open "C:\Program Files\Common Files\Walker Brothers\ErrorHandler\" & ErrMDB For Input As #1
If Err Then
Error_Handler_MDB = False
Exit Function
End If
Close #1
Error_Handler_MDB = True
End Function
Public Function Error_Handler_Create(ByVal ErrMDB As String, ByVal ErrMDBPassword As String) As Boolean
Error_Handler_Create = False
If CreateNewDirectory("C:\Program Files\Common Files\Walker Brothers\ErrorHandler") = False Then
Exit Function
End If
On Error GoTo Err_Handler
If ErrMDBPassword <> "" Then
Set NewDB = Workspaces(0).CreateDatabase("C:\Program Files\Common Files\Walker Brothers\ErrorHandler\" & ErrMDB, dbLangGeneral & ";pwd=" & ErrMDBPassword)
Else
Set NewDB = Workspaces(0).CreateDatabase("C:\Program Files\Common Files\Walker Brothers\ErrorHandler\" & ErrMDB, dbLangGeneral)
End If
'Now call the functions for each table
Dim b As Boolean
b = Error_Handler_Err_List
If b = False Then
Error_Handler_Create = False
NewDB.Close
Set NewDB = Nothing
Exit Function
End If
Error_Handler_Create = True
SetAttr "C:\Program Files\Common Files\Walker Brothers\ErrorHandler\" & ErrMDB, vbHidden
Exit Function
Err_Handler:
If Err.Number <> 0 Then
Error_Handler_Create = False
NewDB.Close
Set NewDB = Nothing
Exit Function
End If
End Function
Public Function Error_Handler_Err_List() As Boolean
Dim TempTDef As TableDef
Dim TempField As Field
Dim TempIdx As Index
Error_Handler_Err_List = False
On Error GoTo Err_Handler
Set TempTDef = NewDB.CreateTableDef("ErrList")
Set TempField = TempTDef.CreateField("ErrDate", 8)
TempField.Attributes = 1
TempField.Required = False
TempField.OrdinalPosition = 0
TempTDef.Fields.Append TempField
TempTDef.Fields.Refresh
Set TempField = TempTDef.CreateField("ErrNum", 4)
TempField.Attributes = 1
TempField.Required = False
TempField.OrdinalPosition = 1
TempTDef.Fields.Append TempField
TempTDef.Fields.Refresh
Set TempField = TempTDef.CreateField("ErrDes", 12)
TempField.Attributes = 2
TempField.Required = False
TempField.OrdinalPosition = 2
TempField.AllowZeroLength = False
TempTDef.Fields.Append TempField
TempTDef.Fields.Refresh
Set TempField = TempTDef.CreateField("ErrNote", 12)
TempField.Attributes = 2
TempField.Required = False
TempField.OrdinalPosition = 3
TempField.AllowZeroLength = False
TempTDef.Fields.Append TempField
TempTDef.Fields.Refresh
Set TempField = TempTDef.CreateField("ErrUser", 10)
TempField.Attributes = 2
TempField.Required = False
TempField.OrdinalPosition = 4
TempField.Size = 50
TempField.AllowZeroLength = True
TempTDef.Fields.Append TempField
TempTDef.Fields.Refresh
NewDB.TableDefs.Append TempTDef
NewDB.TableDefs.Refresh
'Done, Close the objects
Set TempTDef = Nothing
Set TempField = Nothing
Set TempIdx = Nothing
Error_Handler_Err_List = True
Exit Function
Err_Handler:
If Err.Number <> 0 Then
Set TempTDef = Nothing
Set TempField = Nothing
Set TempIdx = Nothing
Error_Handler_Err_List = False
Exit Function
End If
End Function
Public Function CreateNewDirectory(ByVal NewDirectory As String) As Boolean
Dim sDirTest As String
Dim SecAttrib As SECURITY_ATTRIBUTES
Dim bSuccess As Boolean
Dim sPath As String
Dim iCounter As Integer
Dim sTempDir As String
Dim iFlag As Integer
On Error GoTo ErrorCreate
iFlag = 0
sPath = NewDirectory
If Right(sPath, Len(sPath)) <> "\" Then
sPath = sPath & "\"
End If
iCounter = 1
Do Until InStr(iCounter, sPath, "\") = 0
iCounter = InStr(iCounter, sPath, "\")
sTempDir = Left(sPath, iCounter)
sDirTest = Dir(sTempDir)
iCounter = iCounter + 1
'create directory
SecAttrib.lpSecurityDescriptor = &O0
SecAttrib.bInheritHandle = False
SecAttrib.nLength = Len(SecAttrib)
bSuccess = CreateDirectory(sTempDir, SecAttrib)
Loop
CreateNewDirectory = True
Exit Function
ErrorCreate:
CreateNewDirectory = False
Resume 0
End Function
''Usage
'Select Case Error_Handler_Doc("Name.mdb", Now, 123, "Description", "Notes")
'Case "True"
'Case "False"
'End Select


Other 1 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Not Given category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.