ErrorHandleDoc

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

Inputs:
Needs (DatabaseName, Date, Err.Number, Err.Description,
PrivateNotes, Optional(User))
Load in "References" the
"Microsoft DAO 3.51 Object Library"

Assumes:
Basic Error handling information.
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