Dim dtStamp As Date
'...
dtStamp = Now
'Retrieve data from database here
Logger.info "SQL xxx ran " & Format(Now - dtStamp, "n:ss") & " [m:ss]"

Public Const AppVersion As String = "... Version x"

Option Explicit

'This general module is named modLog. Together with class module
'clsLog it offers logging functionality.
'Requires LibFileTools:  https://github.com/cristianbuse/VBA-FileTools
'and GetOperatingSystem: https://www.devhut.net/vba-determine-the-installed-os/
'Usage example:
'
'Sub Main()
'Dim Logger        As clsLog
'Call Start_Log 'Only necessary ONCE on topmost calling level
'Set Logger = New clsLog
'Logger.Name = "Main"
'Logger.LogLevel = g_log_params.log_level
'...
'Logger.info "Some info" 'Or Logger.warn "Some warning" or ...
'...
'Call End_Log 'Only necessary ONCE on topmost calling level
'End Sub
'
'Sub Sub1()
'Dim Logger        As clsLog
'Set Logger = New clsLog
'Logger.Name = "Sub1"
'Logger.LogLevel = g_log_params.log_level
'...
'Logger.info "Some info" 'Or Logger.warn "Some warning" or ...
'...
'End Sub
'
'Version When         Who             What
'      2 19-Jun-2026  Bernd Plumhoff  No support of auto_open in modLog anymore
'      3 24-Aug-2026  Bernd Plumhoff  Replacing precompiler variables by runtime variables
'                                     and getting rid of cached option (which I never used)

Public Enum LogLevel
  logInfo = 0
  logWarn
  logFatal
  logEver     'For messages which cannot be switched off unless logging is disabled
  logDisabled
End Enum

Public Type g_Logger
  log_level                           As LogLevel
  log_sub_name                        As String
  log_screen_row                      As Integer 'Starting at 3, for tab Workflow
  log_file_path                       As String
  log_separate_Logfiles_for_each_User As Boolean
  log_show_WMI_Info                   As Boolean
  log_show_Reference_Details          As Boolean
End Type

Public g_log_params As g_Logger

Sub Start_Log(Optional b_separate_Logfiles_for_each_User As Boolean = False, _
  Optional b_show_WMI_Info As Boolean = False, _
  Optional b_show_Reference_Details As Boolean = False)
Dim i             As Long
Dim s             As String
Dim sDel          As String
Dim sPath         As String
Dim oWMISrvEx     As Object 'SWbemServicesEx
Dim oWMIObjSet    As Object 'SWbemServicesObjectSet
Dim oWMIObjEx     As Object 'SWbemObjectEx
Dim oWMIProp      As Object 'SWbemProperty
Dim sWQL          As String 'WQL Statement
Dim v             As Variant
Dim Logger        As clsLog

Set Logger = New clsLog
Logger.Name = "Start_Log"
Logger.LogLevel = g_log_params.log_level
g_log_params.log_separate_Logfiles_for_each_User = b_separate_Logfiles_for_each_User
g_log_params.log_show_WMI_Info = b_show_WMI_Info
g_log_params.log_show_Reference_Details = b_show_Reference_Details
'LibFileTools are necessary just for the next 5 lines:
sPath = GetLocalPath(ThisWorkbook.Path)
If sPath = "" Then sPath = ThisWorkbook.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sPath = sPath & "Logs\"
If Not IsFolder(sPath) Then CreateFolder (sPath)
If g_log_params.log_separate_Logfiles_for_each_User Then
  'If AppVersion is not defined please define it in your main module like:
  'Public Const AppVersion As String = "Application Version ..."
  g_log_params.log_file_path = sPath & Environ("Userdomain") & _
    "_" & Environ("Username") & "_" & AppVersion & "_" & "Logfile_" & _
    Format(Now, "YYYYMMDD") & ".txt"
Else
  g_log_params.log_file_path = sPath & AppVersion & "_" & _
    "Logfile_" & Format(Now, "YYYYMMDD") & ".txt"
End If
If g_log_params.log_screen_row < 3 Then
  g_log_params.log_screen_row = 3
  wsW.Range("E2:E4").ClearContents
  wsW.Range("5:65535").Delete
End If
With Application
Logger.ever String(180, ">")
Logger.ever "Logging started with " & AppVersion
If g_log_params.log_show_WMI_Info Then
  Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
  For Each v In Array("BaseService", "Processor", "PhysicalMemoryArray", "LogicalDisk", "OperatingSystem")
    'Not: "NetworkAdapterConfiguration", "VideoController", "OnBoardDevice", "Printer", "Product"
    Set oWMIObjSet = oWMISrvEx.ExecQuery("Select * From Win32_" & v)
    For Each oWMIObjEx In oWMIObjSet
      s = v & ": "
      For Each oWMIProp In oWMIObjEx.Properties_
        If Not IsNull(oWMIProp.Value) Then
          If Not IsArray(oWMIProp.Value) Then
            Select Case v
            Case "BaseService"
              If InStr("'SystemName'", "'" & oWMIProp.Name & "'") > 0 Then
                Logger.ever oWMIProp.Name & "='" & Trim(oWMIProp.Value) & "'"
                GoTo Next_v
              End If
            Case "Processor"
              If InStr( _
                "'Name'Description'NumberOfEnabledCore'AddressWidth'DataWidth'CurrentClockSpeed'LoadPercentage'", _
                "'" & oWMIProp.Name & "'") > 0 Then
                If IsNumeric(oWMIProp.Value) Then
                  s = s & oWMIProp.Name & "=" & Format(oWMIProp.Value, "#,##0") & ", "
                Else
                  s = s & oWMIProp.Name & "='" & Trim(oWMIProp.Value) & "', "
                End If
              End If
            Case "PhysicalMemoryArray"
              If InStr("'MaxCapacityEx'", _
                "'" & oWMIProp.Name & "'") > 0 Then s = s & oWMIProp.Name & "=" & _
                Format(oWMIProp.Value, "#,##0") & ", "
            Case "LogicalDisk"
              If InStr("'DeviceID'ProviderName'Size'FreeSpace'", _
                "'" & oWMIProp.Name & "'") > 0 Then
                If IsNumeric(oWMIProp.Value) Then
                  s = s & oWMIProp.Name & "=" & Format(oWMIProp.Value, "#,##0") & ", "
                Else
                  s = s & oWMIProp.Name & "='" & Trim(oWMIProp.Value) & "', "
                End If
              End If
            Case "OperatingSystem"
              If InStr( _
                "'FreePhysicalMemory'FreeVirtualMemory'FreeSpaceInPagingFiles'MaxProcessMemorySize'InstallDate'", _
                "'" & oWMIProp.Name & "'") > 0 Then s = s & oWMIProp.Name & "=" & _
                Format(oWMIProp.Value, "#,##0") & ", "
            End Select
          End If
        End If
      Next oWMIProp
      If Len(s) > Len(v & ": ") Then Logger.ever Left(s, Len(s) - 2)
    Next oWMIObjEx
Next_v:
  Next v
End If
#If Win64 Then
  s = "64"
#Else
  s = "32"
#End If
Logger.ever getOperatingSystem() & " and " & ApplicationVersion() & _
  " (" & s & "-Bit)" '& .Version & .Build & " (" & .CalculationVersion & ")"
Logger.info "Application ThousandsSeparator '" & .ThousandsSeparator & _
  "', DecimalSeparator '" & .DecimalSeparator & "', " & _
  IIf(Not (Application.UseSystemSeparators), "do not ", "") & "use system separators"
Logger.info "App.Internl ThousandsSeparator '" & .International(xlThousandsSeparator) & _
  "', DecimalSeparator '" & .International(xlDecimalSeparator) & "', ListSeparator '" & _
  .International(xlListSeparator) & "'"
Logger.info "App.Internl xlCountryCode '" & .International(xlCountryCode) & _
  "', xlCountrySetting '" & .International(xlCountrySetting) & "'"
End With
With ThisWorkbook.VBProject.References 'In case of error tick box Trust access to the VBA project object
  'model under File / Options / Trust Center / Trust Center Settings / Macro Settings
  s = "VBAProject References: "
  On Error Resume Next
  For i = 1 To .Count
    If g_log_params.log_show_Reference_Details Then
      Logger.info s
      s = ""
      s = s & .Item(i).Description
      s = s & ", FullPath: '" & .Item(i).fullPath & "'"
      s = s & ", Guid: " & .Item(i).GUID
      s = s & ", BuiltIn: " & .Item(i).BuiltIn
      s = s & ", IsBroken: " & .Item(i).IsBroken
      s = s & ", Major: " & .Item(i).Major
      s = s & ", Minor: " & .Item(i).Minor
    Else
      s = s & sDel & .Item(i).Description
      sDel = ", "
    End If
  Next i
  Logger.info s
End With
'Now two examples of environment variables which might not exist for all Windows / Excel installations.
'Use Sub List_Environ_Variables below to see which variables exist on your system.
s = ""
s = Environ("CRC_VDI-TYPE") 'If this does not exist we will not log anything
If s <> "" Then Logger.info "CRC_VDI-TYPE: '" & s & "'"
s = ""
s = Environ("ORACLE_HOME") 'If this does not exist we will not log anything
If s <> "" Then Logger.info "Oracle Client: '" & s & "'"
s = ""
s = Environ("ORACLE_HOME_X64") 'If this does not exist we will not log anything
If s <> "" Then Logger.info "Oracle Client: '" & s & "'"
On Error GoTo 0
End Sub

Sub End_Log()
Dim Logger        As clsLog

Set Logger = New clsLog
Logger.Name = "End_Log"
Logger.LogLevel = g_log_params.log_level
'If AppVersion is not defined please define it in your main module like:
'Public Const AppVersion As String = "Application Version ..."
Logger.ever "Logging finished with " & AppVersion
Logger.ever String(182, "<")
End Sub

Option Explicit

'Version When         Who             What
'      3 24-Aug-2026  Bernd Plumhoff  Replacing precompiler variables by runtime variables
'                                     and getting rid of cached option (which I never used)

Public Const AppVersion As String = "Logging_Version_3"

Sub Logging_Sample()
Dim i        As Long
Dim Logger   As clsLog

Call Start_Log
Set Logger = New clsLog
Logger.Name = "Logging_Sample"
Logger.LogLevel = g_log_params.log_level
 
'Just do something to give log message examples
Logger.LogLevel = logInfo
Logger.ever "Log Level: " & Logger.LogLevel & "  " & String(180, ">")
i = 2
Do While Not IsEmpty(wsData.Cells(i, 1))
  Select Case i
  Case Is < 6
    Logger.info i & " is a number less than 6"
  Case Is < 9
    Call Logging_Warn(i)
  Case Else
    Call Logging_Fatal(i)
  End Select
  i = i + 1
Loop
Logger.ever "Log Level: " & Logger.LogLevel & "  " & String(180, "<")
Logger.LogLevel = logWarn
Logger.ever "Log Level: " & Logger.LogLevel & "  " & String(180, ">")
i = 2
Do While Not IsEmpty(wsData.Cells(i, 1))
  Select Case i
  Case Is < 6
    Logger.info i & " is a number less than 6"
  Case Is < 9
    Call Logging_Warn(i)
  Case Else
    Call Logging_Fatal(i)
  End Select
  i = i + 1
Loop
Logger.ever "Log Level: " & Logger.LogLevel & "  " & String(180, "<")
Logger.LogLevel = logFatal
Logger.ever "Log Level: " & Logger.LogLevel & "  " & String(180, ">")
i = 2
Do While Not IsEmpty(wsData.Cells(i, 1))
  Select Case i
  Case Is < 6
    Logger.info i & " is a number less than 6"
  Case Is < 9
    Call Logging_Warn(i)
  Case Else
    Call Logging_Fatal(i)
  End Select
  i = i + 1
Loop
Logger.ever "Log Level: " & Logger.LogLevel & "  " & String(180, "<")
Logger.LogLevel = logDisabled 'Nothing will be logged, not even EVER
Logger.ever "Log Level: " & Logger.LogLevel & "  " & String(180, ">")
i = 2
Do While Not IsEmpty(wsData.Cells(i, 1))
  Select Case i
  Case Is < 6
    Logger.info i & " is a number less than 6"
  Case Is < 9
    Call Logging_Warn(i)
  Case Else
    Call Logging_Fatal(i)
  End Select
  i = i + 1
Loop
Logger.ever "Log Level: " & Logger.LogLevel & "  " & String(180, "<")
Logger.LogLevel = logInfo
Call End_Log 'Only necessary ONCE on topmost calling level
End Sub
 
'You do not need extra subroutines to log warn messages or fatal messages.
'They are just examples of additional subroutines which do some logging.
Sub Logging_Warn(i As Long)
  Dim Logger   As clsLog
  
  Set Logger = New clsLog
  Logger.Name = "Logging_Warn"
  Logger.LogLevel = g_log_params.log_level
  Logger.warn i & " is 6, 7, or 8"
End Sub
 
Sub Logging_Fatal(i As Long)
  Dim Logger   As clsLog
  
  Set Logger = New clsLog
  Logger.Name = "Logging_Fatal"
  Logger.LogLevel = g_log_params.log_level
  Logger.fatal i & " is greater 8"
End Sub

Option Explicit

'This class module is named clsLog. Together with module modLog it offers logging functionality.
'Version When         Who             What
'      2 19-Jun-2026  Bernd Plumhoff  No support of auto_open in modLog anymore
'      3 24-Aug-2026  Bernd Plumhoff  Replacing precompiler variables by runtime variables
'                                     and getting rid of cached option (which I never used)

Private Type m_Logger
  log_level          As LogLevel
  log_last_level     As LogLevel
  log_sub_name       As String
  log_last_sub_name  As String
  m_saved            As Boolean
End Type
Private m_log_params As m_Logger

Public Property Let Name(sName As String)
  g_log_params.log_sub_name = sName
End Property

Public Property Get Name() As String
  Name = g_log_params.log_sub_name
End Property

Public Property Let LogLevel(ByVal enLevel As LogLevel)
  g_log_params.log_level = enLevel
End Property

Public Property Get LogLevel() As LogLevel
  LogLevel = g_log_params.log_level
End Property

Public Sub info(sLogText As String)
  If g_log_params.log_level = logInfo Then
    Call WriteLog(logInfo, sLogText)
  End If
End Sub

Public Sub warn(sLogText As String)
  If g_log_params.log_level <= logWarn Then
    Call WriteLog(logWarn, sLogText)
  End If
End Sub

Public Sub fatal(sLogText As String)
  If g_log_params.log_level <= logFatal Then
    Call WriteLog(logFatal, sLogText)
  End If
End Sub

Public Sub ever(sLogText As String)
  If g_log_params.log_level <= logEver Then
    Call WriteLog(logEver, sLogText)
  End If
End Sub

Private Sub WriteLog(enLogLevel As LogLevel, sLogText As String)
  Dim FileNum As Integer
  Dim LogMessage As String
  LogMessage = Array("INFO:", "#WARN:", "##FATAL:", "EVER:")(enLogLevel) & _
    " " & Environ("Userdomain") & "\" & Environ("Username") & " " & _
    CStr(Now()) & " [" & g_log_params.log_sub_name & "] - " & sLogText
  FileNum = FreeFile
  Open g_log_params.log_file_path For Append As #FileNum
  Print #FileNum, LogMessage
  Close #FileNum
  wsW.Cells(g_log_params.log_screen_row, 5) = LogMessage
  g_log_params.log_screen_row = g_log_params.log_screen_row + 1
End Sub

Private Sub Class_Initialize()
  m_log_params.log_level = g_log_params.log_level
  m_log_params.log_sub_name = g_log_params.log_sub_name
End Sub

Private Sub Class_Terminate()
  g_log_params.log_level = m_log_params.log_level
  g_log_params.log_sub_name = m_log_params.log_sub_name
End Sub