clsLogFile

Option Explicit
'local variable(s) to hold property value(s)
Private mvarDaysToKeep As Integer 'local copy
Private Const File As String = "classLogFile"
Public Property Let DaysToKeep(ByVal vData As Integer)
  mvarDaysToKeep = vData
End Property

Public Property Get DaysToKeep() As Integer
  DaysToKeep = mvarDaysToKeep
End Property


Public Sub WriteLog(lstrMessage As String, Optional lstrProc As String, Optional lstrFile As String, Optional lboolNewEntry As Boolean)
'**************************************************************
'* procedure to write out log entries
'* it accepts the following parameters:
'*   lstrMessage (String containing the message to be logged)
'*   lstrProc (optional string containing the procedure that
'*     generated the log entry)
'*   lstrFile (optional string containing the file that
'*     contains the procedure that generated the log entry)
'*   lboolNewEntry (optional boolean to force the procedure
'*     to treat this entry as a new entry thereby adding
'*     the entry separation formatting)
'***************************************************************
  Dim lstrMyDate As String
  Dim lstrMyTime As String
  Dim lstrFileName As String
  Dim lintFileNum As Integer
  Dim lstrLogMessage As String
  Dim msg As String
  Const SubName = "Public Sub oError.WriteLog(lstrMessage As String, Optional lstrProc As String, Optional lstrFile As String, Optional lboolNewEntry As Boolean)"
    
  On Error GoTo Error
  ' get a free file number for the error.log file
  lintFileNum = FreeFile
  
  ' assign the file name
  lstrFileName = App.Path & "\error.log"
  ' open the log file
  Open lstrFileName For Append As lintFileNum
  
  ' format and initialize the date and time variables
  lstrMyDate = Format(Date, "mmm dd yyyy")
  lstrMyTime = Format(Time, "hh:mm:ss AMPM")
  
  If lboolNewEntry = True Then
    ' write the top boundary of the log entry.
    lstrLogMessage = lstrMyDate & " " & lstrMyTime & " ********************************************************************************** "
    Print #lintFileNum, lstrLogMessage
  
    If Len(lstrFile) > 0 Then ' write the file
      lstrLogMessage = lstrMyDate & " " & lstrMyTime & " *** File: " & lstrFile
    Else
      lstrLogMessage = lstrMyDate & " " & lstrMyTime & " *** File: Not Supplied"
    End If
    If Len(lstrProc) > 0 Then ' write the procedure
      lstrLogMessage = lstrLogMessage & " ***** " & " Procedure: " & lstrProc
    Else
      lstrLogMessage = lstrLogMessage & " ***** " & " Procedure: Not Supplied"
    End If
    Print #lintFileNum, lstrLogMessage
  End If
  
  ' write the log entry
  lstrLogMessage = lstrMyDate & " " & lstrMyTime & " *** " & lstrMessage
  Print #lintFileNum, lstrLogMessage
  
  If lstrMessage = "Normal Exit" Then
    ' write the bottom boundary of the log entry.
    lstrLogMessage = lstrMyDate & " " & lstrMyTime & " ********************************************************************************** "
    Print #lintFileNum, lstrLogMessage
  End If
  
  'close the log file
  Close lintFileNum
  Exit Sub
Error:
  msg = "Error in creating or editing the error.log file." & vbCrLf
  msg = msg & "Error: " & Err.Number & " - " & Err.Description & vbCrLf
  msg = msg & "Program File: " & File & "Procedure: " & SubName
  MsgBox msg, vbCritical
    
      
End Sub
Private Sub RemoveOldLogEntries(Days As Integer)
'*************************************************************
'* RemoveOldLogEntries is a procedure that, as it's name
'* implies parses thru the lines in the error log file created
'* in the above oError.WriteLog procedure and removes entries
'* past an number of days specified at the time this procedure
'* is called
'* It accepts the following parameters:
'*   Days (an integer that specifies the number of days
'*     beyond which to delete the log entries)
'*************************************************************
  Dim lstrInFileName, lstrOutFileName As String
  Dim lstrLogEntry, lstrEntryDate As String
  Dim lintInFileNum, lintOutFileNum As Integer
  
  Const SubName = "Private Sub RemoveOldLogEntries(Days As Integer)"
  
  On Error GoTo Error
  WriteLog "Removing log entries greater than " & Str(Days) & " days old.", SubName, File, False
  
  ' assign the file name
  lstrInFileName = App.Path & "\error.log"
  lstrOutFileName = App.Path & "\error.tmp"
  
  If Dir(lstrInFileName) = "error.log" Then
    ' get a free file number for the error.log file
    lintInFileNum = FreeFile
    ' open the error.log file for reading and the error.tmp file for writing
    Open lstrInFileName For Input As lintInFileNum
    lintOutFileNum = FreeFile
    Open lstrOutFileName For Append As lintOutFileNum
  
    Do While Not EOF(lintInFileNum)
      Line Input #lintInFileNum, lstrLogEntry  ' Read line into variable.
      
      lstrEntryDate = Left(lstrLogEntry, 11)
      If DateDiff("d", lstrEntryDate, Now) <= Days Then
        Print #lintOutFileNum, lstrLogEntry
        Exit Do
      End If
RecoverFromError:
    On Error GoTo Error:
    Loop
    Do While Not EOF(1)
      Line Input #lintInFileNum, lstrLogEntry
      Print #lintOutFileNum, lstrLogEntry
    Loop
    
    Close #lintInFileNum  ' Close file.
    Close #lintOutFileNum
    Kill lstrInFileName
    Name lstrOutFileName As lstrInFileName
  End If
  Exit Sub
Error:
  If Err.Number = "13" Then
    GoTo RecoverFromError
    
  End If
  
  MsgBox "Error: " & Err.Number & " - " & Err.Description, vbCritical
End Sub
Public Sub SimpleError(Optional SubName As String, Optional FormName As String)
  Dim msg As String
  If Len(SubName) = 0 Then SubName = "Unspecified"
  If Len(FormName) = 0 Then SubName = "Unspecified"
  msg = "Error: " & Err.Number & " - " & Err.Description
  MsgBox msg, vbCritical
  WriteLog msg, SubName, FormName, True
  
End Sub
Private Sub Class_Initialize()
  WriteLog App.EXEName & " Started", "Private Sub Class_Initialize()", File, True
  DaysToKeep = 1
End Sub
Private Sub Class_Terminate()
  WriteLog "Terminating LogFile Object", "Private Sub Class_Terminate()", File, True
  RemoveOldLogEntries DaysToKeep
  WriteLog "Normal Exit", "Private Sub Class_Terminate()", File, True
  
End Sub