Outlook VBA 获取日期范围内的所有 AppointmentItems 并将它们 return 作为集合

Question

我的意思是获取 Date 范围内的所有 AppointmentItem 并将它们 return 作为一个集合。这是我写的函数

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

我尝试了 .IncludeRecurrences = True 和 False。这是我得到的输出。

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

所以我确定了两个问题来得到我的结果：

Line #1 和 Line #2 的输出似乎不一致，在这两种情况下。我不明白为什么在 False 的情况下没有过滤掉前 7 个项目，即使我可以用 True 去除它们。而且我不明白 True 案例中那些太多的 Nothing 项目是什么。
我不知道如何定义一个集合，我可以在其中添加满足 If (Not (oItem Is Nothing)) 条件的项目，所以我可以在退出时 return 它供调用者使用。

问题的解释是什么？ 我怎样才能实现我的目标？

Answer 1

既然您找到了识别所需项目的方法，请将它们添加到新集合中。将该集合传递给调用者。

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

Outlook VBA 获取日期范围内的所有 AppointmentItems 并将它们 return 作为集合

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

vba

date

filter

outlook

restriction