loggerTextFile: Log Messages to Text Files with clsLog--The VBA Logging Framework
This "logger" class module integrates with our VBA logging framework--clsLog--to write messages to text files.
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.
Mike Wolfe
In that article, I wrote about the three parts of a logging framework:
- A logging class that raises events
- One or more "logger" classes with event handlers
- 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 SubNotes 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 theClass_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_DebugSince "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 FunctionImmediate 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
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:
- Create a class module named clsLog using sample code from here
- Create a class module named loggerTextFile using the sample code above
- Update your public Log() function to initialize an instance of
loggerTextFile
