Function to direct debug to text file - excel

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

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

Answer 2

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 \-----------------------------------------------------------------------------/