Question

我有一个函数，它使用用户生成的日期范围从Outlook中提取约会，然后将结果输出到MSGBox中。我想显示预定约会而不显示重复约会。如何修改我的代码以满足我的需求？

我的日期在startDate中定义。通常，此日期是使用日期选择器从UserForm定义的，为此，我手动输入了一个日期。

我设置了oAppointments.IncludeRecurrences = False，但仍然得到定期约会。

代码

Public Function getOutlookAppointments() As String
    Dim oOutlook              As Object
    Dim oNS                   As Object
    Dim oAppointments         As Object
    Dim oFilterAppointments   As Object
    Dim oAppointmentItem      As Object
    Dim bOutlookOpened        As Boolean
    Dim sfilter               As String
    Dim displayText As String
    Dim startDate As Date
    Const olFolderCalendar = 9

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")    'Bind to existing instance of Outlook
    If Err.Number <> 0 Then    'Could not get instance of Outlook, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
        bOutlookOpened = False    'Outlook was not already running, we had to start it
    Else
        bOutlookOpened = True    'Outlook was already running
    End If

    DoEvents

    Set oNS = oOutlook.GetNamespace("MAPI")
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)

    oAppointments.Sort "[Start]"
    oAppointments.IncludeRecurrences = False
    startDate = "07/16/2019"

    sfilter = ("[Start] < """ & Format(startDate, "ddddd h:nn AMPM") & """ and [Start] > """ & Format(startDate + 1, "ddddd h:nn AMPM") & """")
    Set oFilterAppointments = oAppointments.Items.Restrict(sfilter)
    Debug.Print oFilterAppointments.Count & " appointments found."
    'Iterate through each appt in our calendar

    For Each oAppointmentItem In oFilterAppointments
     getOutlookAppointments = getOutlookAppointments & oAppointmentItem.Subject & vbCrLf & oAppointmentItem.start & oAppointmentItem.End


    Next

    MsgBox prompt:=getOutlookAppointments, _
    Title:="Appointments for"


    If bOutlookOpened = False Then    'Since we started Outlook, we should close it now that we're done
        oOutlook.Quit 'There seems to be a delay in this action taking place, but does eventually take place
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oAppointmentItem = Nothing
    Set oFilterAppointments = Nothing
    Set oAppointments = Nothing
    Set oNS = Nothing
    Set oOutlook = Nothing
    Exit Function


    Resume Error_Handler_Exit

    outlookDates = False
End Function

Answer 1

如果要扩展出现次数，则需要设置Items.IncludeRecurrences属性-请参见https://docs.microsoft.com/en-us/office/vba/api/outlook.items.includerecurrences的示例

Answer 2

对出现的事件列表进行过滤将导致IncludeRecurrences属性无法按预期工作。例如，以下序列将返回所有约会事件；重复性和非重复性：（1）按开始属性排序（2）将属性设置为False（3）调用限制（即过滤器）。有关更多信息，请参见Items.IncludeRecurrences。

    Set oNS = oOutlook.GetNamespace("MAPI")
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)

    startDate = "07/16/2019"

    sfilter = ("[Start] < """ & Format(startDate, "ddddd h:nn AMPM") & """ and [Start] > """ & Format(startDate + 1, "ddddd h:nn AMPM") & """")
    Set oFilterAppointments = oAppointments.Items.Restrict(sfilter)
    Debug.Print oFilterAppointments.Count & " appointments found."

如何通过Excel VBA获取Outlook约会而不列出重复约会

2 个答案: