VBA Snippets

LogFile_WriteError

Public Function LogFile_WriteError(ByVal sModuleName As String, _
                                   ByVal sRoutineName As String, _
                                   ByVal smessage As String) As Boolean
                                   
Dim stext As String
'Dim objFSO As Scripting.FileSystemObject
'Dim scrText As Scripting.TextStream

   On Error GoTo AnError

   If (g_objFSO Is Nothing) Then
      Set g_objFSO = New FileSystemObject
   End If
   
   If g_objFSO.FileExists(gsERROR_LOGFOLDER & gsERROR_LOGFILENAME & ".txt") = False Then
       Set g_scrText = g_objFSO.OpenTextFile(gsERROR_LOGFOLDER & gsERROR_LOGFILENAME & ".txt", IOMode.ForWriting, True)
   Else
       Set g_scrText = g_objFSO.OpenTextFile(gsERROR_LOGFOLDER & gsERROR_LOGFILENAME & ".txt", IOMode.ForAppending)
   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
   
   'Set objFSO = Nothing
   
   LogFile_WriteError = True
   Exit Function

AnError:
   Set g_scrText = Nothing
   'Set objFSO = 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 the 'rpod_tech' distribution group.", _
               vbCritical Or vbOKOnly, _
               "Graphex (" & g_sVERSION_NO & ") " & "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"

'Dim objFSO As Scripting.FileSystemObject
'Dim scrText As Scripting.TextStream

   On Error GoTo AnError

   If (g_objFSO Is Nothing) Then
      Set g_objFSO = New FileSystemObject
   End If
   
   If (g_scrText Is Nothing) Then
      If g_objFSO.FileExists(gsERROR_LOGFOLDER & gsERROR_LOGFILENAME & ".txt") = False Then
          Set g_scrText = g_objFSO.OpenTextFile(gsERROR_LOGFOLDER & gsERROR_LOGFILENAME & ".txt", ForWriting, True)
      Else
          Set g_scrText = g_objFSO.OpenTextFile(gsERROR_LOGFOLDER & gsERROR_LOGFILENAME & ".txt", ForAppending)
      End If
   End If
   
   If Len(sCategory) > 0 Then
      g_scrText.WriteLine Format(Date, "dd MMM yyyy") & " - " & Time() & ": " & sCategory & ": " & sTracerMessage
   Else
      If Len(sTracerMessage) > 0 Then
         g_scrText.WriteLine Format(Date, "dd MMM yyyy") & " - " & Time() & ": " & sTracerMessage
      Else
         'g_scrText.WriteLine Format(Date, "dd MMM yyyy") & " - " & Format(Time(), "hh:mm")
      End If
   End If
   g_scrText.Close
   'scrText.Close

   Set g_scrText = Nothing
'   Set scrText = Nothing
'   Set objFSO = Nothing
   Exit Sub
AnError:
   Set g_scrText = Nothing
'   Set scrText = Nothing
'   Set objFSO = Nothing

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

Tracer_AddSubroutineStart

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

   Exit Sub
                                     
   On Error GoTo AnError
   'Call Tracer_Add("SUBROUTINE", "(" & sModuleName & " - " & sRoutineName & ") start " & sAdditionalText)
   Call Tracer_Add("SUB", "(" & sModuleName & " - " & sRoutineName & ") start " & sAdditionalText)
                      
   Exit Sub

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