Outputting VBA results to text file in Outlook 2010 - vba

Question

I am trying to make the below output into a text file on my desktop. I am very new (as in today) and I found the below script online, I have gotten my head around what each but does however I am struggling to make it output as a text file. I am not sure where the commands should go (beginning middle or end?) to do this. I have found one command but I am getting errors left right and centre. Please help.
Sub CountItemsInMBX()
Dim outapp As Outlook.Application
Set outapp = CreateObject("Outlook.Application")
Dim olns As Outlook.NameSpace
Set olns = outapp.GetNamespace("MAPI")
Debug.Print GetSubFolderCount(olns.GetDefaultFolder(olFolderInbox).Parent)
End Sub
Function GetSubFolderCount(objParentFolder As MAPIFolder) As Long
Dim currentFolders As Folders
Dim fldCurrent As MAPIFolder
Set currentFolders = objParentFolder.Folders
If currentFolders.Count > 0 Then
Set fldCurrent = currentFolders.GetFirst
While Not fldCurrent Is Nothing
TempFolderCount = TempFolderCount + GetSubFolderCount(fldCurrent)
Set fldCurrent = currentFolders.GetNext
Wend
Debug.Print objParentFolder.Name & " - " & objParentFolder.Items.Count
GetSubFolderCount = TempFolderCount + objParentFolder.Items.Count
Else
Debug.Print objParentFolder.Name & " - " & objParentFolder.Items.Count
GetSubFolderCount = objParentFolder.Items.Count
End If
End Function

Answer 1

The following is your code, converted to call a function, passing it a string, that will write to a text file. Change the file path & name to suit your needs.
Personally, I don't like the call method because it is a waste to check if the file exists, etc. for every call. However, since your code had two subroutines that need to write text, I was too lazy to embed the proper code in your code. You could either leave as is (if seldom used), or combine together if desired.
Option Explicit
Sub CountItemsInMBX()
Dim outapp As Outlook.Application
Dim olns As Outlook.NameSpace
Set outapp = CreateObject("Outlook.Application")
Set olns = outapp.GetNamespace("MAPI")
'Debug.Print GetSubFolderCount(olns.GetDefaultFolder(olFolderInbox).Parent)
Write_To_MyLog GetSubFolderCount(olns.GetDefaultFolder(olFolderInbox).Parent)
End Sub
Function GetSubFolderCount(objParentFolder As MAPIFolder) As Long
Dim currentFolders As Folders
Dim fldCurrent As MAPIFolder
Dim TempFolderCount As Integer
Set currentFolders = objParentFolder.Folders
If currentFolders.Count > 0 Then
Set fldCurrent = currentFolders.GetFirst
While Not fldCurrent Is Nothing
TempFolderCount = TempFolderCount + GetSubFolderCount(fldCurrent)
Set fldCurrent = currentFolders.GetNext
Wend
'Debug.Print objParentFolder.Name & " - " & objParentFolder.Items.Count
Write_To_MyLog objParentFolder.Name & " - " & objParentFolder.Items.Count
GetSubFolderCount = TempFolderCount + objParentFolder.Items.Count
Else
'Debug.Print objParentFolder.Name & " - " & objParentFolder.Items.Count
Write_To_MyLog objParentFolder.Name & " - " & objParentFolder.Items.Count
GetSubFolderCount = objParentFolder.Items.Count
End If
End Function
Public Function Write_To_MyLog(sText As String)
Dim oFSO As FileSystemObject
Dim oFile As File
Dim oStream As TextStream
On Error GoTo Error_trap
Set oFSO = New FileSystemObject
If Not oFSO.FileExists("C:\Temp\Outlook_Folders.txt") Then
Set oStream = oFSO.CreateTextFile("C:\Temp\Outlook_Folders.txt")
oStream.WriteLine " "
Else
Set oFile = oFSO.GetFile("C:\Temp\Outlook_Folders.txt")
Set oStream = oFile.OpenAsTextStream(ForAppending, TristateMixed)
End If
oStream.WriteLine sText
oStream.Close
Set oStream = Nothing
Set oFile = Nothing
Set oFSO = Nothing
Early_Exit:
Exit Function
Error_trap:
Dim strError As String
strError = "In subroutine: Write_To_MyLog " & vbCrLf & _
Err.Number & vbCrLf & vbCrLf & Err.Description & vbCrLf & _
"At Line: " & Erl
Err.Source = "Module_Utilities: Write_To_MyLog at Line: " & Erl
MsgBox "Error: " & strError
'Write_To_Log strError ' This is a call to a function that saves the error info to a database table.
Resume Early_Exit
Resume Next
End Function