Function to direct debug to text file

Question

I would like to write a function to would allow me to use Print #Debug, "text" throughout my future modules to collect debug statements.

Sub output_debug()
Dim WshShell As Object
Dim Desktop As String
Dim Debug As Integer

Debug = FreeFile()

Set WshShell = CreateObject("WScript.shell")
Desktop = WshShell.specialfolders("Desktop")

Open Desktop & "\VBA_output.txt" For Output As #Debug
Print #Debug, "test"

Close #Debug

End Sub

How can I move from the above, to defining a function that would allow me to use call output_debug() in a module so all my Print #Debug, would print to that file ? I would imagine I need to create another function called close_output() that has close #Debug

Answer 1

Try a subroutine like this... It will log text to a text file with a date stamp, so new file new day. You have an option to pass it the ERR object if you trap the error in your code and it will log the error message with a highlight.

call debuglog("my log entry")

call debuglog("my log entry",err)


Public Sub DebugLog(sLogEntry As String, Optional ByVal oErr As Object)
' write debug information to a log file
Dim iFile As Integer
Dim sDirectory As String
Dim errNumber, errDescription As Variant
Dim l As Integer

If Not oErr Is Nothing Then
    errNumber = oErr.Number
    errDescription = oErr.Description
    l = IIf(Len(errDescription) > Len(sLogEntry), Len(errDescription), Len(sLogEntry))
End If

On Error GoTo bail

sfilename = VBA.Environ("Homedrive") & VBA.Environ("Homepath") & "\My Documents\Debuglog" & "\debuglog" & Format$(Now, "YYMMDD") & ".txt"
iFile = FreeFile

Open sfilename For Append As iFile

If Not oErr Is Nothing Then
    sLogEntry = "/" & String(5 + (l - Len(sLogEntry)), "-") & " " & sLogEntry & " " & String(5 + (l - Len(sLogEntry)), "-") & "\"
    Print #iFile, Now; " "; sLogEntry
    Print #iFile, Now; "  "; errNumber
    Print #iFile, Now; "  "; errDescription
    Print #iFile, Now; " "; "\" & String(Len(sLogEntry) - 2, "-") & "/"
Else
    Print #iFile, Now; " "; sLogEntry
End If

bail:
    Close iFile

End Sub

example logfile output

27/03/2015 10:44:27  -- COMIT Form Initialize - Complete
27/03/2015 10:44:27  -  COMIT Active
27/03/2015 10:44:34  /----- -- Error Populating Opportunity Form: frmBluesheet.PopulateForm() -----\
27/03/2015 10:44:34    381 
27/03/2015 10:44:34   Could not get the Column property. Invalid property array index.
27/03/2015 10:44:34  \-----------------------------------------------------------------------------/

Answer 2

I did something like this in the past. Here is what I came up with. It relies on having a reference to Microsoft Scripting Runtime in any project that uses it. You can store the following subs in a module e.g. DebugLogger (which is what I use) that can be first exported then imported into any module that you want to have this functionality. It mimics the behavior of Debug.Print but sends the output to a file whose name is a function of the workbook's name. I toyed with the idea of time-stamping individual entries but rejected the idea as being too far from the functionality of Debug.Print (I do, however, time stamp the date of creation). Once you import the module and establish the right reference then you can just use DebugLog anywhere you would have used DebugPrint. As a default it also prints to the debug window. You can drop that part of the code entirely or switch what the default is.

Function GetFullDebugName() As String
    'This function returns a string of the form
    '*xldebug.txt, where *.* is the full name of the workbook

    Dim MyName As String
    Dim NameParts As Variant

    MyName = ThisWorkbook.FullName
    NameParts = Split(MyName, ".")
    GetFullDebugName = NameParts(0) & "xldebug.txt"
End Function

Sub CreateDebugFile()
    'file created in same directory as
    'calling workbook

    Dim DebugName As String
    Dim fso As FileSystemObject
    Dim MyStream As TextStream

    Set fso = New FileSystemObject
    DebugName = GetFullDebugName
    Set MyStream = fso.CreateTextFile(DebugName)
    MyStream.WriteLine "This debug file was created " _
                        & FormatDateTime(Date) _
                        & " at " & FormatDateTime(Time)
    MyStream.Close
End Sub

Sub DebugLog(DebugItem As Variant, Optional ToImmediate As Boolean = True)
    Dim DebugName As String
    Dim fso As FileSystemObject
    Dim MyStream As TextStream

    Set fso = New FileSystemObject
    DebugName = GetFullDebugName
    'check to see if DebugFile exist
    'if not, create it:
    If Not fso.FileExists(DebugName) Then CreateDebugFile

    Set MyStream = fso.OpenTextFile(DebugName, ForAppending)
    MyStream.WriteLine DebugItem
    MyStream.Close
    If ToImmediate Then Debug.Print DebugItem
End Sub