'Glogger is declared in module LoggerFactory and set in Sub Start_Log()
Dim dtStamp As Date
'...
dtStamp = Now
'Retrieve data from database here
Glogger.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
'Usage example:
'
'Sub Main()
'Dim GLogger As clsLog
'Start_Log 'Only necessary ONCE on topmost calling level
'Set GLogger = New clsLog
'g_log_params.log_sub_name = "Main"
'...
'GLogger.info "Some info" 'Or GLogger.warn "Some warning" or ...
'...
'End_Log
'End Sub
'
'Sub Sub1()
'Dim GLogger As clsLog 'Now you only need this and the next 2 lines
'Set GLogger = New clsLog
'g_log_params.log_sub_name = "Sub1"
'...
'GLogger.info "Some info" 'Or GLogger.warn "Some warning" or ...
'...
'End Sub
'
'Version When         Who             What
'      1 25-Dec-2025  Bernd Plumhoff  Initial version

#Const Separate_Logfiles_for_each_User = False
#Const Use_Logger_Auto_Open_Close = False      'Enable auto_open and auto_close subs in here
'We like to see recent run's loggging messages on screen in tab Workflow:
#Const Logging_on_Screen = True                'IMPORTANT: Also change this constant in class module clsLog!
'Write logging messages into file at program end to speed this up:
#Const Logging_cashed = False                  'IMPORTANT: Also change this constant in class module clsLog!
#Const Log_WMI_Info = False                    'True shows interesting Windows Management Instrumentation (WMI) data
#Const Show_Reference_Details = False          'True: Show all details; False: Just show description

Public Type g_Logger
  log_level         As Integer 'INFO, WARN, FATAL, EVER, DISABLE_LOGGING
  log_screen_row    As Integer 'Starting at 3, for tab Workflow
  log_file_path     As String
  log_sub_name      As String
End Type

Public Const INFO_LEVEL        As Integer = 0
Public Const WARN_LEVEL        As Integer = 1
Public Const FATAL_LEVEL       As Integer = 2
Public Const EVER_LEVEL        As Integer = 3 'For messages which cannot be switched off unless logging is disabled
Public Const DISABLE_LOGGING   As Integer = 4

Public g_log_params As g_Logger
Public GLogger      As clsLog

 
#If Use_Logger_Auto_Open_Close Then
  Sub auto_open()
  'Version Date        Programmer      What
  '      1 31-Dec-2025 Bernd Plumhoff  Initial version
    Start_Log
  End Sub
  
  Sub auto_close()
  'Version Date        Programmer      What
  '      1 25-Dec-2025 Bernd Plumhoff  Initial version
    End_Log
  End Sub
#End If '#If Use_Logger_auto_Open_Close

Sub Start_Log()
'Version Date        Programmer      What
'      1 31-Dec-2025 Bernd Plumhoff  Initial version
Dim i             As Long
Dim s             As String
Dim sDel          As String
Dim sPath         As String
#If Log_WMI_Info = True Then
  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
#End If
Set GLogger = New clsLog
g_log_params.log_sub_name = "Start_Log"
'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)
End If
#If 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 Logging_on_Screen Then
  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
#End If
With Application
g_log_params.log_sub_name = "Start_Log"
GLogger.ever String(180, ">")
GLogger.ever "Logging started with " & AppVersion
#If Log_WMI_Info = True 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
                GLogger.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 GLogger.ever Left(s, Len(s) - 2)
    Next oWMIObjEx
Next_v:
  Next v
#End If
#If Win64 Then
  s = "64"
#Else
  s = "32"
#End If
GLogger.ever getOperatingSystem() & " and " & ApplicationVersion() & _
  " (" & s & "-Bit)" '& .Version & .Build & " (" & .CalculationVersion & ")"
GLogger.info "Application ThousandsSeparator '" & .ThousandsSeparator & _
  "', DecimalSeparator '" & .DecimalSeparator & "', " & _
  IIf(Not (Application.UseSystemSeparators), "do not ", "") & "use system separators"
GLogger.info "App.Internl ThousandsSeparator '" & .International(xlThousandsSeparator) & _
  "', DecimalSeparator '" & .International(xlDecimalSeparator) & "', ListSeparator '" & _
  .International(xlListSeparator) & "'"
GLogger.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 Show_Reference_Details Then
      GLogger.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
  GLogger.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 GLogger.info "CRC_VDI-TYPE: '" & s & "'"
s = ""
s = Environ("ORACLE_HOME") 'If this does not exist we will not log anything
If s <> "" Then GLogger.info "Oracle Client: '" & s & "'"
s = ""
s = Environ("ORACLE_HOME_X64") 'If this does not exist we will not log anything
If s <> "" Then GLogger.info "Oracle Client: '" & s & "'"
On Error GoTo 0
End Sub

Sub End_Log()
'Change History:
'Version Date        Programmer Change
'1       31-Dec-2025 Bernd      Initial version so that user does not need to use auto_close.
'                               He can manually call this sub.
g_log_params.log_sub_name = "End_Log"
'If AppVersion is not defined please define it in your main module like:
'Public Const AppVersion As String = "Application Version ..."
#If Logging_cashed Then
  Dim i As Long, FileNum As Integer, LogMessage As String
  FileNum = FreeFile
  Open g_log_params.log_file_path For Append As #FileNum
  For i = 3 To g_log_params.log_screen_row - 1
    LogMessage = wsW.Cells(i, 5).Text
    Print #FileNum, LogMessage
  Next i
  Close #FileNum
#End If
GLogger.ever "Logging finished with " & AppVersion
GLogger.ever String(182, "<")
Set GLogger = Nothing 'Necessary, or Class_Terminate() won't be called for GLogger because it's Public
End Sub

Option Explicit

'Version When         Who             What
'    0.3 31-Dec-2025  Bernd Plumhoff  Using modLod and clsLog

Public Const AppVersion As String = "Logging_Version_0.3"

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

Set GLogger = New clsLog
Start_Log
g_log_params.log_sub_name = "Logging_Sample"
 
'Just do something to give log message examples
g_log_params.log_level = INFO_LEVEL
GLogger.ever "Log Level: " & g_log_params.log_level & "  " & String(180, ">")
i = 2
Do While Not IsEmpty(wsData.Cells(i, 1))
  Select Case i
  Case Is < 6
    GLogger.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
GLogger.ever "Log Level: " & g_log_params.log_level & "  " & String(180, "<")
g_log_params.log_level = WARN_LEVEL
GLogger.ever "Log Level: " & g_log_params.log_level & "  " & String(180, ">")
i = 2
Do While Not IsEmpty(wsData.Cells(i, 1))
  Select Case i
  Case Is < 6
    GLogger.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
GLogger.ever "Log Level: " & g_log_params.log_level & "  " & String(180, "<")
g_log_params.log_level = FATAL_LEVEL
GLogger.ever "Log Level: " & g_log_params.log_level & "  " & String(180, ">")
i = 2
Do While Not IsEmpty(wsData.Cells(i, 1))
  Select Case i
  Case Is < 6
    GLogger.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
GLogger.ever "Log Level: " & g_log_params.log_level & "  " & String(180, "<")
g_log_params.log_level = DISABLE_LOGGING 'Nothing will be logged, not even EVER
GLogger.ever "Log Level: " & g_log_params.log_level & "  " & String(180, ">")
i = 2
Do While Not IsEmpty(wsData.Cells(i, 1))
  Select Case i
  Case Is < 6
    GLogger.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
GLogger.ever "Log Level: " & g_log_params.log_level & "  " & String(180, "<")
g_log_params.log_level = INFO_LEVEL
End_Log
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 GLogger As clsLog
  'Initialize logger for this subroutine
  Set GLogger = New clsLog
  g_log_params.log_sub_name = "Logging_Warn"
  GLogger.warn i & " is 6, 7, or 8"
End Sub
 
Sub Logging_Fatal(i As Long)
  Dim GLogger As clsLog
  'Initialize logger for this subroutine
  Set GLogger = New clsLog
  g_log_params.log_sub_name = "Logging_Fatal"
  GLogger.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
'      1 31-Dec-2025  Bernd Plumhoff  Initial version

Private Type m_Logger
  log_level        As Integer
  log_sub_name     As String
End Type
Private m_log_params As m_Logger

'We like to see recent run's loggging messages on screen in tab Workflow:
#Const Logging_on_Screen = True  'IMPORTANT: Also change this constant in module modLog!
'Write logging messages into file at program end to speed this up:
#Const Logging_cashed = False    'IMPORTANT: Also change this constant in module modLog!

Const INFO_LEVEL_TEXT As String = "INFO:"
Const WARN_LEVEL_TEXT As String = "#WARN:"
Const FATAL_LEVEL_TEXT As String = "##FATAL:"
Const EVER_LEVEL_TEXT As String = "EVER:"

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

Public Sub warn(sLogText As String)
  If g_log_params.log_level < modLog.FATAL_LEVEL Then
    Call WriteLog(modLog.WARN_LEVEL, sLogText)
  End If
End Sub

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

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

 
Private Sub WriteLog(iLogLevel As Integer, sLogText As String)
  Dim FileNum As Integer, LogMessage As String, sLogLevel As String
  Select Case iLogLevel
  Case modLog.INFO_LEVEL
    sLogLevel = INFO_LEVEL_TEXT
  Case modLog.WARN_LEVEL
    sLogLevel = WARN_LEVEL_TEXT
  Case modLog.FATAL_LEVEL
    sLogLevel = FATAL_LEVEL_TEXT
  Case modLog.EVER_LEVEL
    sLogLevel = EVER_LEVEL_TEXT
  Case Else
    sLogLevel = "!INVALID LOG LEVEL!"
  End Select
  LogMessage = sLogLevel & " " & Environ("Userdomain") & "\" & Environ("Username") & " " & _
    CStr(Now()) & " [" & g_log_params.log_sub_name & "] - " & sLogText
  #If Not Logging_cashed Then
    FileNum = FreeFile
    Close #FileNum
    Open g_log_params.log_file_path For Append As #FileNum
    Print #FileNum, LogMessage
    Close #FileNum
  #End If
  #If Logging_on_Screen Then
    wsW.Cells(g_log_params.log_screen_row, 5) = LogMessage
    g_log_params.log_screen_row = g_log_params.log_screen_row + 1
  #End If
End Sub

Private Sub Class_Initialize()
  #If Logging_cashed And Not Logging_on_Screen Then
    Err.Raise Number:=vbObjectError + 513, Description:="Logging_cashed requires Logging_on_Screen"
  #End If
  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