loggerTextFile: Log Messages to Text Files with clsLog--The VBA Logging Framework

Mike Wolfe -

In an earlier article, I wrote about my no-frills logging framework for VBA, clsLog:

clsLog: A VBA Logging Framework
Introducing clsLog, the no-frills logging framework. Prepare to supercharge your Access logging with the closest thing to NLog or Log4j in the VBA world.
No Longer SetMike Wolfe

In that article, I wrote about the three parts of a logging framework:

  1. A logging class that raises events
  2. One or more "logger" classes with event handlers
  3. One or more instances of the logging class and associated logger(s)

In this article, I'll show you a sample logger class you can use to output log messages to text files.

loggerTextFile

Here's the interesting sample code for the loggerTextFile class module.  

Please note this first excerpt will not compile, as it is missing several custom procedures I've written over the years.  The purpose of showing the excerpt is to highlight the important bits of the logger class:

Private WithEvents mLog As clsLog
    
Private mLogFullPath As String

Public Level As ll__LogLevel

Private Sub Class_Initialize()
    'Set defaults
    Level = ll_None
    
    'https://nolongerset.com/getting-the-temp-folder-in-vba/
    Dim LogFolder As String
    LogFolder = PathJoin(Environ("TMP"), "loggerTextFile")
    EnsurePathExists LogFolder
    
    'Auto-generate a new file each month to keep performance in check (note: for now, old files are not auto-deleted)
    mLogFullPath = PathJoin(LogFolder, CurrentProject.Name & "-" & Format(VBA.Date, "yyyy-mm") & ".log")
    Debug.Print "Logging to " & mLogFullPath
End Sub

Public Sub Init(LogToSink As clsLog, DefaultLevelToLog As ll__LogLevel)
    Set mLog = LogToSink
    Me.Level = DefaultLevelToLog
End Sub

Private Sub mLog_LogEntry(Msg As String, Level As ll__LogLevel, Dict As Variant, LevelTxt As String)
    'Don't raise errors in production environment
    'If App.IsProd Then        '<-- uncomment to raise errors in dev; see: https://nolongerset.com/environmentally-friendly-access/
        On Error Resume Next
    'End If
    
    
    'Don't log errors less than the level of the current logger instance
    If Level < Me.Level Then Exit Sub
    
    LogMessage Msg, LevelTxt
End Sub

Private Sub LogMessage(Msg As String, LevelTxt As String)
    Dim TimeStamp As String
    TimeStamp = Format(VBA.Now, "yyyy-mm-dd hh:nn:ss")
    
        
#If vbWatchdogAvailable = 1 Then
    'Move up the call stack past the logging calls
    Dim Stack As ErrExCallstack
    Set Stack = ErrEx.LiveCallstack
    Stack.FirstLevel
    Stack.NextLevel
    Stack.NextLevel
    Stack.NextLevel
    Stack.NextLevel
        
    'Show the full call stack (sans logging calls)
    Dim CodeLocation As String
    CodeLocation = Stack.ModuleName & "." & _
        Stack.ProcedureName
    Do While Stack.NextLevel
        CodeLocation = Stack.ModuleName & "." & _
            Stack.ProcedureName & " --> " & CodeLocation
    Loop
                    
    FileAppend mLogFullPath, _
        TimeStamp & vbTab & _
        LevelTxt & vbTab & _
        CodeLocation & vbTab & _
        Msg
#Else
    FileAppend mLogFullPath, _
        TimeStamp & vbTab & _
        LevelTxt & vbTab & _
        Msg
            
#End If
        
End Sub

Notes About the Code Above

There are a few parts of the above code to which I'd like to draw your attention:

  • Log files get created in a subfolder of the user temp folder named loggerTextFile (you can adjust this in the Class_Initialize() method)
  • A portion of the current date is used to construct the log file name
  • By adjusting the date format, you can control how many log files get created
  • There is no code to auto-delete past log files (that's left as a reader exercise)
  • The message format includes a full date-time stamp and string version of the logging level
  • If you have vbWatchdog, you can also include the full call stack

Full Code

To make use of the sample code below, you'll first need to read the above article and create a clsLog class module in your VBA project.

Once you've done that, you'll need to copy the code below into a new class module named loggerTextFile.

This particular logger class module uses several other procedures from my extensive code library.  For convenience, I've included all required procedures as private members of the class module in the sample code below.

Here are links to the referenced articles (the links are also included in the code comments alongside the sample code):

'class module named: loggerTextFile
Option Compare Database
Option Explicit

Private WithEvents mLog As clsLog
    
Private mLogFullPath As String
Private mLogFolder As String

Public Level As ll__LogLevel

'declaration for EnsurePathExists() function
Private Declare PtrSafe Function SHCreateDirectoryEx _
    Lib "shell32" Alias "SHCreateDirectoryExW" _
    (ByVal hwnd As LongPtr, ByVal pszPath As LongPtr, ByVal psa As Any) As Long

'declaration for DeleteFile() function
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Class_Initialize()
    'Set defaults
    Level = ll_None
    
    'https://nolongerset.com/getting-the-temp-folder-in-vba/
    mLogFolder = PathJoin(Environ("TMP"), "loggerTextFile")
    EnsurePathExists mLogFolder
    
    'Auto-generate a new file each month to keep performance in check (note: for now, old files are not auto-deleted)
    mLogFullPath = PathJoin(mLogFolder, CurrentProject.Name & "-" & Format(VBA.Date, "yyyy-mm") & ".log")
    Debug.Print "Logging to " & mLogFullPath
End Sub

Public Sub Init(LogToSink As clsLog, DefaultLevelToLog As ll__LogLevel)
    Set mLog = LogToSink
    Me.Level = DefaultLevelToLog
End Sub

Private Sub mLog_LogEntry(Msg As String, Level As ll__LogLevel, Dict As Variant, LevelTxt As String)
    'Don't raise errors in production environment
    'If App.IsProd Then        '<-- uncomment to raise errors in dev; see: https://nolongerset.com/environmentally-friendly-access/
        On Error Resume Next
    'End If
    
    
    'Don't log errors less than the level of the current logger instance
    If Level < Me.Level Then Exit Sub
    
    LogMessage Msg, LevelTxt
End Sub

Private Sub LogMessage(Msg As String, LevelTxt As String)
    Dim TimeStamp As String
    TimeStamp = Format(VBA.Now, "yyyy-mm-dd hh:nn:ss")
    
        
#If vbWatchdogAvailable = 1 Then
    'Move up the call stack past the logging calls
    Dim Stack As ErrExCallstack
    Set Stack = ErrEx.LiveCallstack
    Stack.FirstLevel
    Stack.NextLevel
    Stack.NextLevel
    Stack.NextLevel
    Stack.NextLevel
        
    'Show the full call stack (sans logging calls)
    Dim CodeLocation As String
    CodeLocation = Stack.ModuleName & "." & _
        Stack.ProcedureName
    Do While Stack.NextLevel
        CodeLocation = Stack.ModuleName & "." & _
            Stack.ProcedureName & " --> " & CodeLocation
    Loop
                    
    FileAppend mLogFullPath, _
        TimeStamp & vbTab & _
        LevelTxt & vbTab & _
        CodeLocation & vbTab & _
        Msg
#Else
    FileAppend mLogFullPath, _
        TimeStamp & vbTab & _
        LevelTxt & vbTab & _
        Msg
            
#End If
        
End Sub


'---------------------------------------------------------------------------------------
' Procedure : PathJoin
' Author    : Mike Wolfe (mike@nolongerset.com)
' Source    : https://nolongerset.com/joining-paths-in-vba/
' Date      : 10/21/2015
' Purpose   : Intelligently joins path components automatically dealing with backslashes.
' Notes     - To add a trailing backslash, pass a single backslash as the final parameter.
'           - If there is no single backslash passed at the end, there will be no trailing
'               backslash (even if the final parameter contains a trailing backslash).
'           - A leading backslash in the first parameter will be left in place.
'           - Empty path components are ignored.
'---------------------------------------------------------------------------------------
'>>> PathJoin("C:\", "Users", "Public", "\")
'C:\Users\Public\
'>>> PathJoin("C:", "Users", "Public", "Settings.ini")
'C:\Users\Public\Settings.ini
'>>> PathJoin("\\localpc\C$", "\Users\", "\Public\")
'\\localpc\C$\Users\Public
'>>> PathJoin("\\localpc\C$", "\Users\", "\Public\", "")
'\\localpc\C$\Users\Public
'>>> PathJoin("\\localpc\C$", "\Users\", "\Public\", "\")
'\\localpc\C$\Users\Public\
'>>> PathJoin("Users", "Public")
'Users\Public
'>>> PathJoin("\Users", "Public\Documents", "New Text Document.txt")
'\Users\Public\Documents\New Text Document.txt
'>>> PathJoin("C:\Users\", "", "Public", "\", "Documents", "\")
'C:\Users\Public\Documents\
'>>> PathJoin("C:\Users\Public\")
'C:\Users\Public
'>>> PathJoin("C:\Users\Public\", "\")
'C:\Users\Public\
'>>> PathJoin("C:\Users\Public", "\")
'C:\Users\Public\
Private Function PathJoin(ParamArray PathComponents() As Variant) As String
    Dim LowerBound As Integer
    LowerBound = LBound(PathComponents)

    Dim UpperBound As Integer
    UpperBound = UBound(PathComponents)

    Dim i As Integer
    For i = LowerBound To UpperBound
        Dim Component As String
        Component = CStr(PathComponents(i))

        If Component = "\" And i = UpperBound Then
            'Add a trailing slash
            PathJoin = PathJoin & "\"
        Else
            'Strip trailing slash if necessary
            If Right(Component, 1) = "\" Then Component = Left(Component, Len(Component) - 1)

            'Strip leading slash if necessary
            If i > LowerBound And Left(Component, 1) = "\" Then Component = Mid(Component, 2)

            If Len(Component) = 0 Then
                'do nothing
            Else
                PathJoin = Conc(PathJoin, Component, "\")
            End If
        End If
    Next i
End Function

' ----------------------------------------------------------------
' Procedure : EnsurePathExists
' DateTime  : 8/15/2022
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/ensurepathexists/
' Purpose   : Unicode-safe method to ensure a folder exists
'               and create it (and all subfolders) if it does not.
' ----------------------------------------------------------------
Private Function EnsurePathExists(PathToCheck As String) As Boolean
    Const ERROR_SUCCESS As Long = &H0
    Const ERROR_ACCESS_DENIED As Long = &H5         'Could not create directory; access denied.
    Const ERROR_BAD_PATHNAME As Long = &HA1         'The pszPath parameter was set to a relative path.
    Const ERROR_FILENAME_EXCED_RANGE As Long = &HCE 'The path pointed to by pszPath is too long.
    Const ERROR_FILE_EXISTS As Long = &H50          'The directory exists.
    Const ERROR_ALREADY_EXISTS As Long = &HB7       'The directory exists.
    Const ERROR_CANCELLED As Long = &H4C7           'The user canceled the operation.
    Const ERROR_INVALID_NAME As Long = &H7B         'Unicode path passed when SHCreateDirectoryEx passes PathToCheck as string.
    
    Dim ReturnCode As Long
    ReturnCode = SHCreateDirectoryEx(ByVal 0&, StrPtr(PathToCheck), ByVal 0&)
    
    Select Case ReturnCode
    Case ERROR_SUCCESS, _
         ERROR_FILE_EXISTS, _
         ERROR_ALREADY_EXISTS
        EnsurePathExists = True
    
    Case ERROR_ACCESS_DENIED: Throw "Could not create {0}.  Access denied.", PathToCheck
    Case ERROR_BAD_PATHNAME: Throw "Cannot use relative path: {0}", PathToCheck
    Case ERROR_FILENAME_EXCED_RANGE: Throw "Path too long: {0}", PathToCheck
    Case ERROR_CANCELLED: Throw "User cancelled CreateDirectory operation on {0}", PathToCheck
    Case ERROR_INVALID_NAME: Throw "Invalid path name: {0}", PathToCheck
    Case Else: Throw "Unexpected error {0} verifying path", ReturnCode
    End Select
End Function

'Dummy implementation; for full code refer to:
'    https://nolongerset.com/throwing-errors-in-vba/
Private Sub Throw(Msg As String, Var As Variant)
    Debug.Print Replace(Msg, "{0}", "'" & Var & "'")
End Sub

'Writes a text file with the contents of a string
'   - Creates the file if it does not exist
'   - Overwrites the contents of an existing file without warning
'   - Returns true if successful
'https://nolongerset.com/text-files-read-write-append/
Function FileWrite(FName As String, Contents As String) As Boolean
    If Not DeleteFile(FName) Then Exit Function
    Dim FNum As Integer
    FNum = FreeFile()
    Open FName For Output As FNum
    'trailing semi-colon needed to prevent adding blank line at end of file
    '  see: http://stackoverflow.com/a/9445141/154439
    Print #FNum, Contents;
    Close #FNum
    FileWrite = True
End Function

'Appends the contents to the end of a file
' - if the file does not exist, it is created
' - a new line is implicitly added after the contents
'   `- this means that FileAppend may be repeatedly called without passing any vbCrLf's
'https://nolongerset.com/text-files-read-write-append/
Private Sub FileAppend(FName As String, Contents As String)
    If Not FileExists(FName) Then
        'File does not exist, create new via FileWrite
        FileWrite FName, Contents & vbCrLf
    Else
        Dim FNum As Integer
        FNum = FreeFile()
        Open FName For Append Access Write As #FNum
        Print #FNum, Contents
        Close #FNum
    End If
End Sub


'https://nolongerset.com/the-subtle-dangers-of-dir/
Private Function FileExists(FullPathOfFile As String) As Boolean
    Dim HasWildcards As Boolean
    HasWildcards = (InStr(FullPathOfFile, "*") > 0) Or (InStr(FullPathOfFile, "?") > 0)
    
    If HasWildcards Then
        FileExists = (Len(Dir(FullPathOfFile)) > 0)
    Else
        Dim oFSO As Object 'Scripting.FileSystemObject
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        FileExists = oFSO.FileExists(FullPathOfFile)
    End If
End Function

'https://nolongerset.com/kill-failed-let-user-try-again/
Private Function DeleteFile(FName As String, _
                            Optional DelayInSeconds As Long = 0, _
                            Optional Silent As Boolean = False) As Boolean
    Dim StartTime As Date, Complete As Boolean
    On Error Resume Next
    StartTime = Now()
    Do Until Complete
        Err.Clear
        Kill FName
        If Not FileExists(FName) Then
            DeleteFile = True
            Complete = True
            Exit Function
        End If
        If Err.Number <> 0 Then
            If (Now() - StartTime) * 86400 > DelayInSeconds Then
                If Not Silent Then
                    If MsgBox("Unable to delete file:" & vbCrLf & vbCrLf & _
                              FName & vbCrLf & vbCrLf & _
                              "Ensure the file is closed and you have the permissions to delete it.", _
                              vbRetryCancel, "File Delete Failed") = vbCancel Then
                        DeleteFile = False
                        Complete = True
                        Exit Function
                    End If
                Else
                    Complete = True
                End If
            Else
                Sleep 1000 ' wait for 1 second before trying again
            End If
        End If
    Loop
End Function


'---------------------------------------------------------------------------------------
' Procedure : Conc
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/come-together/
' Date      : 1/23/2009 - 4/1/2015
' Purpose   : Concatenates two strings
' Notes     : Eliminates the need to strip off the leading/trailing delimiter when
'               building a string list
' 4/17/09   - If StartText is filled, but nextval is empty, then StartText is returned unchanged.
' 5/ 1/09   - Changed return type of conc from Variant to String.
' 4/ 1/15   - Allow passing Nulls as StartText.
'>>> Conc("1, 2, 3", "4")
' 1, 2, 3, 4
'>>> Conc("This", "that", " and ")
' This and that
'>>> Conc("Five", Null, " and ")
' Five
'>>> Conc(Null, "Dime", " and ")
' Dime
'>>> "#" & Conc(Null, Null) & "#"
' ##
'---------------------------------------------------------------------------------------
'
Private Function Conc(StartText As Variant, NextVal As Variant, _
                      Optional Delimiter As String = ", ") As String
    If Len(Nz(StartText)) = 0 Then
        Conc = Nz(NextVal)
    ElseIf Len(Nz(NextVal)) = 0 Then
        Conc = StartText
    Else
        Conc = StartText & Delimiter & NextVal
    End If
End Function

Sample Usage

In the sample below, I start by calling log.Dbug from the Immediate window.  This initializes the loggerTextFile class.  The Class_Initialize() method outputs the file location of the log file to the immediate window (regardless of the logger's default logging level).

The log file gets created in a subfolder of the local user temp folder:

C:\Users\Mike\AppData\Local\Temp\loggerTextFile\

This first call also creates a new text file named LoggingSample.accdb-2024-07.log.  Note the inclusion of the year and month in the file name.  This ensures that the log file gets rotated and no single log file gets too big.  The sample logger is set to create a new file every month.  You can increase or decrease the frequency of that by adjusting the mLogFullPath assignment in Class_Initialize() to use a date format other than "yyyy-mm".  

Next, I call log.Fatal.  This appends a second line to the existing log file.

Next, I call log.Trace.  This does not append a line to the log file because we set the minimum logging level to ll_Debug when we initialized the logger: 

mTextFileLogger.Init mLog, ll_Debug

Since "Trace" is lower in priority than "Debug" according to the ll__LogLevel enum in clsLog, our text file logger ignores the call to log.Trace.  Note that if we wanted to log all messages–including trace messages–we could simply pass ll_Trace or ll_All to the mTextFileLogger class's Init method.

Finally, I call log.Info.  This appends a third line to the existing log file.  Note that there is no gap between the log.Fatal line and the log.Info line in the resulting text file.

Logger Initialization

Private mLog As clsLog
Private mTextFileLogger As loggerTextFile

Public Function Log() As clsLog
    If mLog Is Nothing Then
        Set mLog = New clsLog
        
        'Reset loggers just in case they are pointed at
        '   a destroyed instance of clsLog
        Set mTextFileLogger = Nothing
    End If
    Set Log = mLog
    
    'Initialize each logger
    If mTextFileLogger Is Nothing Then
        Set mTextFileLogger = New loggerTextFile
        mTextFileLogger.Init mLog, ll_Debug
    End If        
End Function

Immediate Window

log.Dbug "Test debug message"
Logging to C:\Users\Mike\AppData\Local\Temp\loggerTextFile\LoggingSample.accdb-2024-07.log
log.Fatal "Test fatal message"
log.Trace "Test trace message"
log.Info "Test info message"

LoggingSample.accdb-2024-07.log

2024-07-30 22:59:49	DEBUG	Test debug message
2024-07-30 23:00:08	FATAL	Test fatal message
2024-07-30 23:01:04	INFO	Test info message
The sample Log() function in the screenshot above also includes a reference to the MsgBox Logger, as discussed in the original clsLog VBA Logging Framework article.

Summary

Implementing the loggerTextFile logger class is a three-step process:

  1. Create a class module named clsLog using sample code from here
  2. Create a class module named loggerTextFile using the sample code above
  3. Update your public Log() function to initialize an instance of loggerTextFile