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

编程问答 2022-06-03

问题描述

我的意思是获取AppointmentItem范围内的所有Date，并将它们作为集合返回。 这是我写的功能

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

所以我确定了两个问题才能得出结果：

  1. 在两种情况下，Line #1和Line #2的输出似乎不一致。 我不明白为什么False中的前7个项目没有被过滤掉，即使我可以用True摆脱它们。 而且我不了解在nothing情况下，True项太多了。
  2. 我不知道如何定义一个Collection，可以在其中添加满足If (Not (oItem Is nothing))条件的项目，因此我可以在退出时将其返回以供调用方使用。

问题的解释是什么？ 我如何实现我的目标？

解决方法

由于找到了一种识别所需项目的方法，因此请将其添加到新集合中。将该集合传递给呼叫者。

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
datefilterfilteroutlookrestriction