output debug.print window

[DMT Dave]

Hi Guy's is there an easy way to output the results from the immediate window to ie: .docx or Excel or access report ?

[Welshgasman]

Not that I am aware of?
You could just copy and paste?

[moke123]

Those results from the immediate window must be coming from somewhere, so what are you debug.printing?
You can probably write it to a text file.

Sub sCreateATextFile(Destination As String, Optional Txt As String = "xxx")


    Dim fso As FileSystemObject, ts As TextStream


    'Create the FileSystemObject
    Set fso = New FileSystemObject
    'Create the TextStream
    Set ts = fso.CreateTextFile(Destination & "TestMe.txt")
    'Write a line ending with NewLine to text file
    ts.Write Txt
    'Close the file
    ts.Close


    'Clean up memory
    Set fso = Nothing
    Set ts = Nothing


End Sub

[DMT Dave]

Hi Moke123, thank you so much for your reply, the line highlighted in red gives me appointment results in the immediate window, If I try and make a variable for it instead, it won't let me do that.....

If varOpt = "7" Then     
    myStart = InputBox("Enter Start Date ?" & vbNewLine & vbNewLine & "Default Is Today", "ENTER START DATE", Date)
    iMonths = InputBox("Enter How Many Months From Now You Want To Search Appointments ?" & vbNewLine & vbNewLine & _
    "Default Is 3 Months", "ENTER MONTHS", 3)
    
    myEnd = DateAdd("m", iMonths, myStart)
    
   ' Debug.Print "Start:", myStart
   ' Debug.Print "End:", myEnd
     
    Set olobj = CreateObject("Outlook.Application")
    Set oloappt = olobj.CreateItem(olAppointmentItem)
    
    Set oCalendar = oloappt.Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
     
    oItems.IncludeRecurrences = True
    oItems.Sort "[Start]"
     
    strRestriction = "[Start] <= '" & Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") _
    & "' AND [End] >= '" & Format(myStart, "mm/dd/yyyy hh:mm AMPM") & "'"
    
   ' Debug.Print strRestriction
     
    'Restrict the Items collection
    Set oResItems = oItems.Restrict(strRestriction)
     
    For Each oAppt In oResItems
        Debug.Print "Appointment Date: " & oAppt.Start, "Appointmnet Subject: " & oAppt.subject
    
    Next
    
End If

I am not able to try something like

strMSG ="Appointment Date: " & oAppt.Start, "Appointmnet Subject: " & oAppt.subject

MsgBox(strMSG)

Or an output

I have made a template file called > Outlook Appointments.docx in my word docs folder, if i could output to there instead would be fab

however, i will look at your FSystem option also

[DMT Dave]

@Moke123 is your Sub a public sub in a module or can I Dim within the same procedure ?

[Welshgasman]

Dave,
Instead of Debug.Print you would ts.Write whatever it is you want to see.

[DMT Dave]

Thanks WGM, yes as per Moke123 suggestion, coming back to this later but much appreciate your input

[DMT Dave]

I have tried adding Moke123 as a public sub in my Public Sub modules

then changed debug.print to ts.write but it's returning Object required, i can't be reading / understanding ts.write perhaps as i haven't used before

Public Sub

Option Compare DatabaseOption Explicit


 Public Sub sCreateATextFile(Destination As String, Optional Txt As String = "xxx")




    Dim fso As FileSystemObject, ts As TextStream




    'Create the FileSystemObject
    Set fso = New FileSystemObject
    'Create the TextStream
    Set ts = fso.CreateTextFile(Destination & "TestMe.txt")
    'Write a line ending with NewLine to text file
    ts.Write Txt
    'Close the file
    ts.Close




    'Clean up memory
    Set fso = Nothing
    Set ts = Nothing
End Sub

If varOpt = "7" Then     
    myStart = InputBox("Enter Start Date ?" & vbNewLine & vbNewLine & "Default Is Today", "ENTER START DATE", Date)
    iMonths = InputBox("Enter How Many Months From Now You Want To Search Appointments ?" & vbNewLine & vbNewLine & _
    "Default Is 3 Months", "ENTER MONTHS", 3)
    
    myEnd = DateAdd("m", iMonths, myStart)
    
   ' Debug.Print "Start:", myStart
   ' Debug.Print "End:", myEnd
     
    Set olobj = CreateObject("Outlook.Application")
    Set oloappt = olobj.CreateItem(olAppointmentItem)
    
    Set oCalendar = oloappt.Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
     
    oItems.IncludeRecurrences = True
    oItems.Sort "[Start]"
     
    strRestriction = "[Start] <= '" & Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") _
    & "' AND [End] >= '" & Format(myStart, "mm/dd/yyyy hh:mm AMPM") & "'"
    
   ' Debug.Print strRestriction
     
    'Restrict the Items collection
    Set oResItems = oItems.Restrict(strRestriction)
     
    For Each oAppt In oResItems
        ts.Write "Appointment Date: " & oAppt.Start, "Appointmnet Subject: " & oAppt.subject OBJECT REQUIRED
    
    Next
    
End If

[Minty]

You need to use call the function Moke provided :

sCreateATextFile("C:\MyTextFiles\DebugOutput.txt", "Appointment Date: " & oAppt.Start, "Appointmnet Subject: " & oAppt.subject)

Personally I would put the destination filepath and the captured text into variables and pass them into the function/sub

[moke123]

try something like . . .

For Each oAppt In oResItems
        strOut = Strout & "Appointment Date: " & oAppt.Start, "Appointmnet Subject: " & oAppt.subject  & vbnewline
Next

sCreateATextFile "C:\MyTextFiles\DebugOutput.txt", strOut

If you want to do it within the loop you'd need to use an append procedure.

something like...

Sub OpenTextFileAppend(sTextFilePath As String)
    ' Must add reference to Tools > References > Microsoft Scripting Runtime
    ' (1) Open an instance of the FileSystemObject.
    ' (2) Open an instance of the FileSystemObject TextStream.
    ' (3) Append lines to the TextStream object.
    ' (4) Close the TextStream object.


    Dim fso As Scripting.FileSystemObject
    Dim tsTxtFile As Scripting.TextStream
    
    ' (1) Open an instance of the FileSystemObject.
    Set fso = New Scripting.FileSystemObject
    
    ' (2) Open an instance of the FileSystemObject TextStream.
    Set tsTxtFile = fso.OpenTextFile(sTextFilePath, ForAppending, False, TristateMixed)
        
    With tsTxtFile
    
        ' (3) Append lines to the TextStream object.
        '.WriteBlankLines 6
        If .Line = 2 Then .Skip 10
        .WriteLine "[1] Appended at the end of the TextStream xxx"
         If .Line <> 1 Then .Skip 2
        .WriteLine "[1] Appended at the end of the TextStream xxx"
        
        ' (4) Close the TextStream object.
        .Close
        
    End With
    
    Set fso = Nothing


End Sub

Doing it the first way is probably easier.

[DMT Dave]

Thank you guy's i need more time to understand the ts.write option which i will do, however, i have managed to output to an email body

If varOpt = "7" Then     
    myStart = InputBox("Enter Start Date ?" & vbNewLine & vbNewLine & "Default Is Today", "ENTER START DATE", Date)
    iMonths = InputBox("Enter How Many Months From Now You Want To Search Appointments ?" & vbNewLine & vbNewLine & _
    "Default Is 3 Months", "ENTER MONTHS", 3)
    
    myEnd = DateAdd("m", iMonths, myStart)


    Set olobj = CreateObject("Outlook.Application")
    Set oloappt = olobj.CreateItem(olAppointmentItem)
    
    Set oCalendar = oloappt.Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
     
    oItems.IncludeRecurrences = True
    oItems.Sort "[Start]"
     
    strRestriction = "[Start] <= '" & Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") _
    & "' AND [End] >= '" & Format(myStart, "mm/dd/yyyy hh:mm AMPM") & "'"
    
    Set oResItems = oItems.Restrict(strRestriction)
     
    For Each oAppt In oResItems
        
            strOut = strOut & oAppt.Start & " " & oAppt.subject & "|"
    Next
    
    Set MyItem = myApp.CreateItem(olMailItem)
    Set OutAccount = myApp.Session.Accounts.Item(1)
    
        With MyItem
        .To = ""
        .subject = "Appointments"
        .HTMLBody = "Appointments Between " & Format(myStart, "dddd-dd-mmmm-yyyy") & " And " & Format(myEnd, "dddd-dd-mmmm-yyyy") & "<br>" & "<br>" & _
        strTable & "<br>" & Replace(strOut, "|", "<br>") & "<br>" & strLine & "<br>" & strTableEnd
        .SendUsingAccount = OutAccount
        .Display
        
    End With
        
End If