Get only today's appointments through Outlook VBA - vba

Question

I am extracting all appointments across all Outlook accounts for today.
I am experiencing the same issue encountered in this post here, but I am trying to do this through VBA.
Originally I managed to get the appointments for today, but it would also return reoccurring meetings that are not taking place today (like in the linked question).
I do not understand how the Powershell code, in the answer, manages to filter out the reoccurring appointments, because in my VBA attempt I get the whole week of appointments.
This is my attempt. I've included the filter where I get the appointments for today as well the reoccurring appointments which do not take place today.
Sub GetAllCalendarAppointmentsForToday()
Dim olApplication As Outlook.Application
Dim olNamespace As NameSpace
Dim olAccounts As Accounts
Dim olStore As Outlook.Store
Dim olCalendarFolder As Outlook.Folder
Dim olCalendarItems As Outlook.Items
Dim olTodayCalendarItems As Outlook.Items
Dim strFilter As String
Dim strFilter2 As String
Set olApplication = CreateObject("Outlook.Application")
Set olNamespace = olApplication.Session
Set olAccounts = olNamespace.Accounts
Debug.Print olAccounts.Count
For Each oAccount In olAccounts
Debug.Print oAccount
Set olStore = oAccount.DeliveryStore
Set olCalendarFolder = olStore.GetDefaultFolder(olFolderCalendar)
Set olCalendarItems = olCalendarFolder.Items
olCalendarItems.Sort "[Start]", True
olCalendarItems.IncludeRecurrences = True
Debug.Print olCalendarItems.Count
'Find your today's appointments
strFilter = Format(Now, "ddddd")
strFilter2 = Format(DateAdd("d", 7, Now), "ddddd")
Debug.Print strFilter
Debug.Print strFilter2
'strFilter = "[Start] > " & Chr(34) & strFilter & " 00:00" & Chr(34) & " AND [Start] < " & Chr(34) & strFilter & " 00:00" & Chr(34)
strFilter = "[Start] > " & Chr(34) & strFilter & " 00:00" & Chr(34) & " AND [Start] < " & Chr(34) & strFilter2 & " 00:00" & Chr(34)
Debug.Print strFilter
Set olTodayCalendarItems = olCalendarItems.Restrict(strFilter)
Debug.Print olTodayCalendarItems.Count
Debug.Print "Begin Print of Appointments"
For Each objAppointment In olTodayCalendarItems
Counter = Counter + 1
Debug.Print Counter & ":" & objAppointment.Subject & " " & objAppointment.Location & " [" & objAppointment.Start & "|" & objAppointment.End & "]"
Next
Debug.Print vbNewLine
Next
End Sub
Edit #1:
As per Eugene's answer, I updated the strFilter to be this to no avail
strFilter = [Start] <= '07/15/2020 11:59 PM' AND [End] >= '07/15/2020 12:00 AM'
In addition, I put IncludeReccurence first as well and no change in the results
Edit #2
Replaced the for each loop to use GetFirst() and GetNext() to no avail
Set olTodayCalendarItems = olCalendarItems.Restrict(strFilter)
Set olItem = olTodayCalendarItems.GetFirst()
Do While Not olItem Is Nothing
Set olAppointment = olItem
counter = counter + 1
Debug.Print counter & ":" & olAppointment.Subject & " " & olAppointment.Location & " [" & olAppointment.Start & "|" & olAppointment.End & "]"
Set olItem = olTodayCalendarItems.GetNext()
Loop
Edit #3:
I created a VB.NET application where I used the function, provided in the link in the answer, verbatim and it worked as expected. So maybe there is a issue in VBA (unlikely) or I missed something small in my VBA script?
Edit #4:
The problem was in my logic all along. Items needed to be sorted in ascending. Thank you to both Eugene and niton

Answer 1

The OP left a comment to indicate Restrict is valid.
" ... the link to the docs on IncludeRecurrences ... mentioned that .Sort needs to be done in ascending order"
It is possible .Restrict is not appropriate for this task.
An example using .Find.
Items.IncludeRecurrences property(Outlook) https://learn.microsoft.com/en-us/office/vba/api/outlook.items.includerecurrences
Sub DemoFindNext()
' https://learn.microsoft.com/en-us/office/vba/api/outlook.items.includerecurrences
Dim myNameSpace As Outlook.NameSpace
Dim tdystart As Date
Dim tdyend As Date
Dim myAppointments As Outlook.Items
Dim currentAppointment As Outlook.AppointmentItem
Set myNameSpace = Application.GetNamespace("MAPI")
tdystart = VBA.Format(Now, "Short Date")
tdyend = VBA.Format(Now + 1, "Short Date")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
myAppointments.Sort "[Start]"
myAppointments.IncludeRecurrences = True
Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
While TypeName(currentAppointment) <> "Nothing"
Debug.Print currentAppointment.Subject
' MsgBox currentAppointment.Subject
Set currentAppointment = myAppointments.FindNext
Wend
End Sub

Answer 2

Microsoft doesn’t recommend using the Count property in case you set the IncludeRecurrences property. The Count property may return unexpected results and cause an infinite loop. Read more about that in the How To: Use Restrict method in Outlook to get calendar items article.
Here is a sample VB.NET code where you can see how you can filter appointment items properly:
Imports System.Text
Imports System.Diagnostics
' ...
Private Sub RestrictCalendarItems(folder As Outlook.MAPIFolder)
Dim dtEnd As DateTime = New DateTime(DateTime.Now.Year, DateTime.Now.Month, _
DateTime.Now.Day, 23, 59, 0, 0)
Dim restrictCriteria As String = "[Start]<=""" + dtEnd.ToString("g") + """" + _
" AND [End]>=""" + DateTime.Now.ToString("g") + """"
Dim strBuilder As StringBuilder = Nothing
Dim folderItems As Outlook.Items = Nothing
Dim resultItems As Outlook.Items = Nothing
Dim appItem As Outlook._AppointmentItem = Nothing
Dim counter As Integer = 0
Dim item As Object = Nothing
Try
strBuilder = New StringBuilder()
folderItems = folder.Items
folderItems.IncludeRecurrences = True
folderItems.Sort("[Start]")
resultItems = folderItems.Restrict(restrictCriteria)
item = resultItems.GetFirst()
Do
If Not IsNothing(item) Then
If (TypeOf (item) Is Outlook._AppointmentItem) Then
counter = counter + 1
appItem = item
strBuilder.AppendLine("#" + counter.ToString() + _
" Start: " + appItem.Start.ToString() + _
" Subject: " + appItem.Subject + _
" Location: " + appItem.Location)
End If
Marshal.ReleaseComObject(item)
item = resultItems.GetNext()
End If
Loop Until IsNothing(item)
If (strBuilder.Length > 0) Then
Debug.WriteLine(strBuilder.ToString())
Else
Debug.WriteLine("There is no match in the " _
+ folder.Name + " folder.")
End If
catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.Message)
Finally
If Not IsNothing(folderItems) Then Marshal.ReleaseComObject(folderItems)
If Not IsNothing(resultItems) Then Marshal.ReleaseComObject(resultItems)
End Try
End Sub