VBA Filter All-Day Outlook Reoccurring Appointments for Today

Question

How can I use the VBA restrict function to filter for all day reoccurring Outlook calendar appointments that are today? I have a reoccurring appointment every other week and it's set as an all-day appointment.

My attempt:

Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Set calendarItems = olApp.Session.GetDefaultFolder(olFolderCalendar).Items

'Documentation says sort the collection first, then set include recurrences
'https://learn.microsoft.com/en-us/office/vba/api/outlook.items.includerecurrences
calendarItems.Sort "[Start]"
calendarItems.IncludeRecurrences = True

'filter for restrict: [Start] < "<tomorrow>" and [Start] >= "<today>"
criteria = "[Start] < " & Chr(34) & VBA.Format(Now + 1, "Short Date") & Chr(34) & " and [Start] >= " & Chr(34) & VBA.Format(Now, "Short Date") & Chr(34)

Set todayAppointments = calendarItems.Restrict(criteria)

'Print info for debugging
For Each Item In todayAppointments
    Debug.Print (Item.Subject & " " & Item.ConversationTopic & " " & Item.Organizer & " " & Item.Start & " " & Item.End)
Next

This will bring up the regular appointments that occur today, but not the reoccurring appointment.

I can get the reoccurring appointment if I expand my filter to be one day before today, i.e. VBA.Format(Now - 1, "Short Date"), then it brings in my reoccurring appointment for today. However, then I also get other appointments for the previous day which is not what I wanted.

score 1 · Accepted Answer · answered Mar 21 '23 at 00:25

Add a time component.

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant


Private Sub ApptToday()

Dim calendarItems As Items
Dim todayAppointments As Items

Dim item As Object

Set calendarItems = Session.GetDefaultFolder(olFolderCalendar).Items

'Documentation says sort the collection first, then set include recurrences
'https://learn.microsoft.com/en-us/office/vba/api/outlook.items.includerecurrences
calendarItems.Sort "[Start]"
calendarItems.IncludeRecurrences = True

Dim criteria1 As String
criteria1 = "[Start] < " & Chr(34) & VBA.Format(Now + 1, "Short Date") & Chr(34) & " AND [Start] >= " & Chr(34) & VBA.Format(Now, "Short Date") & Chr(34)
Debug.Print
Debug.Print criteria1
Set todayAppointments = calendarItems.Restrict(criteria1)

'Print info for debugging
For Each item In todayAppointments
    If item.Class = olAppointment Then
        Debug.Print (item.subject & " " & item.ConversationTopic & " " & item.Organizer & " " & item.Start & " " & item.End)
    End If
Next


Dim criteria2 As String
criteria2 = "[Start] < " & Chr(34) & VBA.Format(Now + 1, "Short Date") & " 00:00" & Chr(34) & " AND [Start] >= " & Chr(34) & VBA.Format(Now, "Short Date") & " 00:00" & Chr(34)
Debug.Print
Debug.Print criteria2
Set todayAppointments = calendarItems.Restrict(criteria2)

'Print info for debugging
For Each item In todayAppointments
    If item.Class = olAppointment Then
        Debug.Print (item.subject & " " & item.ConversationTopic & " " & item.Organizer & " " & item.Start & " " & item.End)
    End If
Next

Dim criteria3 As String
criteria3 = "[Start] < " & Chr(34) & VBA.Format(Date + 1, "yyyy-mm-dd hh:nn") & Chr(34) & " AND [Start] >= " & Chr(34) & VBA.Format(Date, "yyyy-mm-dd hh:nn") & Chr(34)
Debug.Print
Debug.Print criteria3
Set todayAppointments = calendarItems.Restrict(criteria3)

'Print info for debugging
For Each item In todayAppointments
    If item.Class = olAppointment Then
        Debug.Print (item.subject & " " & item.ConversationTopic & " " & item.Organizer & " " & item.Start & " " & item.End)
    End If
Next

End Sub

Eugene Astafiev · Answer 2 · 2023-03-21T15:52:27.823

You need to set properties in the reverse order. Instead of sorting the collection first you need to include recurrences first of all:

calendarItems.IncludeRecurrences = True
calendarItems.Sort "[Start]"

Although dates and times are typically stored with a date format, filters using the Jet and DAV Searching and Locating (DASL) syntax require that the date-time value to be converted to a string representation. In Jet syntax, the date-time comparison string should be enclosed in either double quotes or single quotes. In DASL syntax, the date-time comparison string should be enclosed in single quotes.

To make sure that the date-time comparison string is formatted as Microsoft Outlook expects, use the Visual Basic for Applications Format function. The following example creates a Jet filter to find all items that have been modified before June 12, 2022 at 3:30 P.M local time.

criteria = "[LastModificationTime] < '" _ 
         & Format("6/12/2022 3:30PM","General Date") & "'"

Read more about that in the articles that I wrote for the technical blog:

VBA Filter All-Day Outlook Reoccurring Appointments for Today

2 Answers2