Outlook VBA get all AppointmentItems in a Date range and return them as a Collection - vba

Question

I mean to get all AppointmentItems in a Date range and return them as a Collection.
This is the function I wrote
Function GetAppointmentItemsDatesRange(ByVal dstart As Date, ByVal dend As Date) As Outlook.Items
'=======================================================
' Get all AppointmentItem in a range of dates
'=======================================================
Dim oCalendar As Outlook.Folder
Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
Dim objItems As Outlook.Items
Dim objRestrictedItems As Outlook.Items
Set objItems = oCalendar.Items
objItems.IncludeRecurrences = True
'objItems.IncludeRecurrences = False
objItems.Sort "[Start]"
Dim filterRange As String
filterRange = "[Start] >= " & Chr(34) & Format(dstart, "dd/mm/yyyy hh:mm AM/PM") & Chr(34) & " AND " & _
"[End] <= " & Chr(34) & Format(dend, "dd/mm/yyyy hh:mm AM/PM") & Chr(34) ' <-- Line #1'
Set objRestrictedItems = objItems.Restrict(filterRange)
Debug.Print "Filter : " & filterRange
Dim oItem As Outlook.AppointmentItem
Dim iIt As Long
Dim nItFilter As Long, nIt As Long
nItFilter = objRestrictedItems.Count
nIt = 0
Debug.Print nItFilter & " total items"
For Each oItem In objRestrictedItems
If (Not (oItem Is Nothing)) Then
nIt = nIt + 1
Debug.Print oItem.Start & "-" & oItem.End ' <-- Line #2'
End If
Next oItem
Debug.Print nIt & " net items"
Set GetAppointmentItemsDatesRange = objRestrictedItems
End Function
I tried with both .IncludeRecurrences = True and False.
This is the output I get.
False:
Filter : [Start] >= "07/11/2020 05:30 PM" AND [End] <= "07/11/2020 06:15 PM"
9 total items
31/12/2015 9:00:00-31/12/2015 9:00:00
31/01/2017 15:30:00-31/01/2017 15:30:00
18/03/2020 12:00:00-18/03/2020 16:00:00
13/04/2020 8:45:00-13/04/2020 9:00:00
09/09/2020 11:00:00-09/09/2020 12:00:00
28/09/2020 14:45:00-28/09/2020 18:00:00
01/10/2020 13:30:00-01/10/2020 15:00:00
07/11/2020 17:30:00-07/11/2020 17:45:00
07/11/2020 17:45:00-07/11/2020 18:15:00
9 net items
True:
Filter : [Start] >= "07/11/2020 05:30 PM" AND [End] <= "07/11/2020 06:15 PM"
2147483647 total items
07/11/2020 17:30:00-07/11/2020 17:45:00
07/11/2020 17:45:00-07/11/2020 18:15:00
2 net items
So I identify two problems to get to my result:
The outputs of Line #1 and Line #2 seem inconsistent, in both cases.
I do not understand why are the first 7 items not filtered out in the False case, even if I can get rid of them with True.
And I do not understand what are those too many Nothing items in the True case.
I do not know hot to define a Collection where I can add the items that satisfy the If (Not (oItem Is Nothing)) condition, so I can return it upon exiting for the caller to use.
What is the explanation for the questions?
How can I achieve my goal?

Answer 1

Since you found a way to identify the required items, add them to a new collection. Pass that collection to the caller.
Option Explicit
Sub collNotNothingItems()
Dim dtSt As Date
Dim dtEn As Date
Dim notNothingItems As Collection
Dim i As Long
dtSt = Date - 7
dtEn = Date
Set notNothingItems = GetAppointmentItemsDatesRange(dtSt, dtEn)
Debug.Print notNothingItems.count & " in the collection passed to the caller"
For i = 1 To notNothingItems.count
With notNothingItems(i)
Debug.Print .Start & "-" & .End
End With
Next
End Sub
Function GetAppointmentItemsDatesRange(ByVal dstart As Date, ByVal dend As Date) As Collection
'=======================================================
' Get all AppointmentItem in a range of dates
'=======================================================
Dim oCalendar As Folder
Dim objItems As Items
Dim objRestrictedItems As Items
Dim filterRange As String
Dim myItems As Collection
Dim oItem As AppointmentItem
Dim iIt As Long
Dim nItFilter As Long
Dim nIt As Long
Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
Set objItems = oCalendar.Items
objItems.IncludeRecurrences = True
objItems.Sort "[Start]"
'filterRange = "[Start] >= " & Chr(34) & Format(dstart, "dd/mm/yyyy hh:mm AM/PM") & Chr(34) & " AND " & _
"[End] <= " & Chr(34) & Format(dend, "dd/mm/yyyy hh:mm AM/PM") & Chr(34)
filterRange = "[Start] >= " & Chr(34) & Format(dstart, "yyyy-mm-dd hh:mm AM/PM") & Chr(34) & " AND " & _
"[End] <= " & Chr(34) & Format(dend, "yyyy-mm-dd hh:mm AM/PM") & Chr(34)
Debug.Print "filterRange: " & filterRange
Set objRestrictedItems = objItems.Restrict(filterRange)
nItFilter = objRestrictedItems.count
Debug.Print nItFilter & " total items"
nIt = 0
Set myItems = New Collection
For Each oItem In objRestrictedItems
If (Not (oItem Is Nothing)) Then
nIt = nIt + 1
Debug.Print oItem.Start & "-" & oItem.End
myItems.Add oItem
End If
Next oItem
Debug.Print nIt & " net items"
Set GetAppointmentItemsDatesRange = myItems
End Function