Error Handler Document

by WalkerBro (2 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: Visual Basic 3.0
Difficulty: Unknown Difficulty
Date Added: Wed 3^rd February 2021
Rating: (103 Votes)

This code pastes into a Module that Create (if not exists) a MDB to record the errors that occur in your application.

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.
Code Returns
True or False if it was succesful.
Side Effects
No known side effects.
API Declarations
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

Rate Error Handler Document

'*   Created by Walker Brother (tm)
'*   web page : http://www.walkerbro.8m.com
'*   e-mail  : [email protected]
'*   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

Download this snippet Add to My Saved Code

Error Handler Document Comments

No comments have been posted about Error Handler Document. Why not be the first to post a comment about Error Handler Document.

Error Handler Document

Error Handler Document Comments

Post your comment

Difficulty