Outlook VBA получает все элементы AppointmentItems в диапазоне дат и возвращает их как коллекцию

Я имею в виду получить все 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 кажутся противоречивыми в обоих случаях. Я не понимаю, почему первые 7 элементов не отфильтровываются в случае False, даже если я могу избавиться от них с помощью True. И я не понимаю, что это за слишком много Nothing предметов в True случае.
  2. Я не знаю, как определить коллекцию, в которую я могу добавить элементы, удовлетворяющие условию If (Not (oItem Is Nothing)), поэтому я могу вернуть ее при выходе для использования вызывающей стороной.

Какое объяснение вопросов? Как я могу достичь своей цели?


filter date outlook vba restriction
person sancho.s ReinstateMonicaCellio    schedule 11.11.2020    source источник
comment
Пожалуйста, посмотрите здесь, как Microsoft рекомендует нечто подобное. Забудьте о «конкретном слове в теме»…   -  person FaneDuru    schedule 11.11.2020
comment
@FaneDuru - Несколько комментариев: 1) dstart и dend - это Date, согласно прототипу функции. Я не уверен, как иначе сделать то, что вы предлагаете. 2) Я думаю, что это несущественно в любом случае. VBA не заботится о том, как я создаю filterRange, который является String. Он заботится только о своем содержимом. 3) Я прочитал источник, на который вы ссылаетесь. Так что я не понимаю, что конкретно вы предлагаете. Не могли бы вы опубликовать код, чтобы проиллюстрировать это? Спасибо   -  person sancho.s ReinstateMonicaCellio    schedule 11.11.2020
comment
Извините, я не видел две переменные, такие как аргументы функции. Я удалю комментарий.   -  person FaneDuru    schedule 11.11.2020
comment
Здравствуйте, попробуйте изменить эту строку objItems.IncludeRecurrences = False на objItems.IncludeRecurrences = True. Я думаю, что может происходить то, что повторяющиеся события календаря по-прежнему включаются в том виде, в каком они появились в этом временном диапазоне, но отображаются с первоначально запланированным временем. Кроме того, я считаю, что для строки даты ожидается формат ddddd hh:nn AMPM, я думаю, что его тоже нужно обновить.   -  person Ryan Wildry    schedule 11.11.2020
comment
@RyanWildry - я пробовал это раньше и соответственно расширил свой вопрос. Может это вариант для моих нужд, надо еще доделать.   -  person sancho.s ReinstateMonicaCellio    schedule 11.11.2020
comment
@sancho.sReinstateMonicaCellio - Похоже, что objItems.IncludeRecurrences = True дает правильный вывод, это правильно?   -  person Ryan Wildry    schedule 11.11.2020
comment
@RyanWildry - Не совсем так. Полученная коллекция, по-видимому, содержит n=2147483647 элементов (или с моей стороны может быть некоторая неверная интерпретация, поскольку n=2^31-1, и, вероятно, это не совпадение). Поэтому мне приходится отфильтровывать многие элементы с помощью моего If (Not (oItem Is Nothing)). Это было бы нормально, если бы я мог использовать это, чтобы собрать коллекцию, которая будет возвращена из функции и использована вызывающей стороной, как указано в вопросе.   -  person sancho.s ReinstateMonicaCellio    schedule 11.11.2020

Ответы (1)


arrow_upward
1
arrow_downward

Поскольку вы нашли способ определить необходимые элементы, добавьте их в новую коллекцию. Передайте эту коллекцию вызывающему абоненту.

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
person niton    schedule 12.11.2020
comment
Так что я пропустил предложение New Collection... Я хотел бы иметь в качестве возвращаемого типа Outlook.Items (более конкретно). Вы скажете, что я могу просто заменить Collection на Outlook.Items? - person sancho.s ReinstateMonicaCellio; 13.11.2020
comment
Вы можете опубликовать отдельный вопрос с примером кода, показывающего, почему предпочтительнее возвращать элементы. - person niton; 13.11.2020
comment
Кажется, об этом уже спрашивали... и это возможно только через громоздкую реализацию. stackoverflow.com/questions/29071174/ stackoverflow.com/questions/5695977/ - person sancho.s ReinstateMonicaCellio; 13.11.2020