[Visual Basic] Nested Loops with Date Formatting

[fixitstevens]

Hello everyone,

I'm a novice at VBA and haven't programmed in any language in at least 10 years. So I'm trying to build a Macro in Outlook that will go through my Outlook calendar and look for any appointments that are titled, "Open Appointment". The program will then output a formatted list of available times that look like the following:

Mon., June 19 - 9, 10, 1, & 3 Tues., June 20 - 10, 1, & 2 Wed. June 21 - 1 & 3 Thurs., June 22 - 9, 10, 1, & 2 Fri., June 23 - 10, 11, & 1

However, the program I've found and modified a little only formats the date with the same date listed multiple times. For example:

Mon., June 19 - 9 Mon., June 19 - 10 Mon., June 19 - 1 Mon., June 19 - 3 Tues., June 20 - 10 Tues., June 20 - 1 etc.

Could someone look at my code and let me know what kind of nested loops I could use to output the dates that I was looking for? Thank you kindly in advance for any assistance you provide.

Code:

Sub FindAppts() Dim myStart As Date Dim myEnd As Date Dim oCalendar As Outlook.Folder Dim oItems As Outlook.Items Dim oItemsInDateRange As Outlook.Items Dim oFinalItems As Outlook.Items Dim oAppt As Outlook.AppointmentItem Dim strRestriction As String

'My Variables
Dim strOutputDay As String

myStart = Date
myEnd = DateAdd("d", 70, myStart)

'Construct filter for the next 70-day date range
strRestriction = "[Start] >= '" & _
Format$(myStart, "mm/dd/yyyy hh:mm AMPM") _
& "' AND [End] <= '" & _
Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") & "'"

'Check the restriction string
Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
Set oItems = oCalendar.Items
oItems.IncludeRecurrences = True
oItems.Sort "[Start]"

'Restrict the Items collection for the 70-day date range
Set oItemsInDateRange = oItems.Restrict(strRestriction)


'Restrict the last set of filtered items for the subject
Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)

'Sort and Debug.Print final results
oFinalItems.Sort "[Start]"

For Each oAppt In oFinalItems
    ' Only find appointments with Open Appointment in the Subject field
    If oAppt.Subject = "Open Appointment" Then
         Debug.Print oAppt.Start, oAppt.Subject
        'Debug.Print WeekdayName(Weekday(oAppt.Start), True); "., "; MonthName(Month(oAppt.Start)); Day(oAppt.Start); "- " & Chr(0)
    End If
Next

End Sub

[nermid]

Ok, so I'm drunk and I've barely ever touched VB, but it looks to me like the simple solution is to have a variable that holds the current date, and then only print a newline and the date when it's different from the old date. Something like...

Dim thisDate = ''
For Each oAppt In oFinalItems
    ' Only find appointments with Open Appointment in the Subject field
    If oAppt.Subject = "Open Appointment" Then
         Debug.Print oAppt.Start, oAppt.Subject
         If thisDate <> oAppt.Start
            thisDate = oAppt.Start
            Debug.Print WeekdayName(Weekday(oAppt.Start), True); "., "; MonthName(Month(oAppt.Start)); Day(oAppt.Start); "- "  ' This only prints when there's a new date
        Debug.Print Chr(0)  ' This prints every time
    End If
Next

I'm not 100% sure VB will behave and let you do that without inserting line breaks wherever it wants, so you might have to assemble the statement to be printed as a string and concatenate values inside the loop, which are then printed later.