VBA Snippets

DetailedLogging_Read

Public Function DetailedLogging_Read() As Boolean
   DetailedLogging_Read = False
'    DetailedLogging_Read = CBool(Registry_Read(g_sCOMPANYNAME, g_sSOLUTIONNAME, "DetailedLogging", "False"))
End Function

DetailedLogging_Save

Public Sub DetailedLogging_Save(bvalue As Boolean)
'   Call Registry_Save(g_sCOMPANYNAME, g_sSOLUTIONNAME, "DetailedLogging", bvalue)
End Sub

LogFile_WriteError

Public Function LogFile_WriteError( _
         ByVal sModuleName As String, _
         ByVal sRoutineName As String, _
         ByVal smessage As String) As Boolean
                                   
Dim stext As String

   On Error GoTo ErrorHandler

   If (g_oFSO Is Nothing) Then
       Set g_oFSO = New FileSystemObject
   End If   

   If (g_scrText Is Nothing) Then
      If (modGeneral.Folder_Exists(g_sERROR_LOGFOLDER, False) = False) Then
         Call modGeneral.Folder_Create(g_sERROR_LOGFOLDER, False)
      End If
      If g_oFSO.FileExists(g_sERROR_LOGFOLDER & g_sERROR_LOGFILENAME & ".txt") = False Then
         Set g_scrText = g_oFSO.OpenTextFile(g_sERROR_LOGFOLDER & g_sERROR_LOGFILENAME & ".txt", IOMode.ForWriting, True)
      Else
         Set g_scrText = g_oFSO.OpenTextFile(g_sERROR_LOGFOLDER & g_sERROR_LOGFILENAME & ".txt", IOMode.ForAppending)
      End If
   End If
   
   stext = stext & "" & vbCrLf
   stext = stext & Format(Date, "dd MMM yyyy") & " - " & Time() & ": EXCEPTION_MESSAGE" & vbCrLf
   stext = stext & "  " & sModuleName & " - " & sRoutineName & vbCrLf
   stext = stext & "  " & smessage & vbCrLf
   
   g_scrText.WriteLine stext
   g_scrText.Close
   
   Set g_scrText = Nothing
      
   LogFile_WriteError = True
   Exit Function

AnError:
   Set g_scrText = Nothing   
   LogFile_WriteError = False
   
   Call MsgBox("Unable to write the error message to the log file." & vbCrLf & vbCrLf & _
               sModuleName & " - " & sRoutineName & vbCrLf & _
               smessage & vbCrLf & vbCrLf & _
               Err.Number & " - " & Err.Description & vbCrLf & vbCrLf & _
               "Please send a screen shot of this message in an e-mail to 'support@bettersolutions.com'.", _
               vbCritical Or vbOKOnly, _
               g_sCOMPANYNAME & " (" & g_sVERSIONNO & ") " & "modGeneral - LogFile_WriteError")
End Function

Tracer_Add

Public Sub Tracer_Add( _
         ByVal sCategory As String, _
         ByVal sTracerMessage As String, _
Optional ByVal bAlwaysLogged As Boolean = False)

Const sPROCNAME As String = "Tracer_Add"

   On Error GoTo ErrorHandler

   If ((bAlwaysLogged = False) And (DetailedLogging_Read = False)) Then
       Exit Sub
   End If
   If (g_objFSO Is Nothing) Then
      Set g_objFSO = New FileSystemObject
   End If
   sTracerMessage = Replace(sTracerMessage, vbCrLf & vbCrLf, vbCrLf)

   If (g_scrText Is Nothing) Then
      If (Folder_Exists(g_sERROR_LOGFOLDER, False) = False) Then
          Call Folder_Create(g_sERROR_LOGFOLDER, False)
      End If

      If g_oFSO.FileExists(g_sERROR_LOGFOLDER & g_sERROR_LOGFILENAME & ".txt") = False Then
          Set g_scrText = g_oFSO.OpenTextFile(g_sERROR_LOGFOLDER & g_sERROR_LOGFILENAME & ".txt", ForWriting, True)
      Else
          Set g_scrText = g_oFSO.OpenTextFile(g_sERROR_LOGFOLDER & g_sERROR_LOGFILENAME & ".txt", ForAppending)
      End If
   End If
   
   If Len(sCategory) > 0 Then
      g_scrText.WriteLine Format(Date, "dd MMM yyyy") & " - " & Time() & ": " & sCategory & ": " & sTracerMessage
      If (sCategory = "MESSAGE") Or (sCategory = "QUESTION") Then
          g_scrText.WriteLine ""
      End If
   Else
      If Len(sTracerMessage) > 0 Then
         g_scrText.WriteLine Format(Date, "dd MMM yyyy") & " - " & Time() & ": " & sTracerMessage
      Else
         g_scrText.WriteLine ""
      End If
   End If
   g_scrText.Close
   Set g_scrText = Nothing

   Exit Sub
ErrorHandler:
   g_scrText.Close
   Set g_scrText = Nothing
   Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
End Sub

Tracer_AddSubroutineStart

This can be added immediately after the "On Error GoTo ErrorHandler" to track exactly which subroutines and functions are called.

Public Sub Tracer_AddSubroutineStart( _
         ByVal sModuleName As String, _
         ByVal sRoutineName As String, _
Optional ByVal sAdditionalText As String = "")

Const sPROCNAME As String = "Tracer_AddSubroutineStart"
                                     
   On Error GoTo ErrorHandler

   If (DetailedLogging_Read = True) Then
      Call Tracer_Add("SUB", "(" & sModuleName & " - " & sRoutineName & ") start " & sAdditionalText)
   End If
                      
   Exit Sub

ErrorHandler:
   Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
End Sub

Public Sub Testing()
Const sPROCNAME As String = "Testing"
   On Error GoTo ErrorHandler
   Call Tracer_AddSubroutineStart(msMODULENAME, sPROCNAME)

End Sub