时间戳

首页 > 解决方案 > 如何在 Excel 中从给定日期获取 Outlook 约会

excel - 如何在 Excel 中从给定日期获取 Outlook 约会

问题描述

我想在 MessageBox 中显示给定日期的 Outlook 日历约会。不幸的是，我使用的代码没有显示今天的任何约会。如果我将代码更改为， sfilter = "[Start] >= '" & startDate & "' " 那么我将获得今天的约会以及其他日期的所有未来约会。我只想显示指定日期的约会。

日期选择来自UserForm被调用的cmDates.srtDate.Value

sFilter是我在整个代码中使用保持日期过滤器的变量

代码

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 rslt                  As String
    Dim sfilter               As String
    Dim startDate             As Date
    Dim displayText As String
    Dim start 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
    On Error GoTo Error_Handler
    DoEvents

    Set oNS = oOutlook.GetNamespace("MAPI")
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
    startDate = cmDates.srtDate.value
    'Apply a filter so we don't waste our time going through old stuff if we don't need to.
    sfilter = "[Start] = '" & startDate & "' "
    Set oFilterAppointments = oAppointments.Items.Restrict(sfilter)

    For Each oAppointmentItem In oFilterAppointments
     getOutlookAppointments = getOutlookAppointments & oFilterAppointments.Count & " appointment(s) found" & vbCrLf & vbCrLf & oAppointmentItem.Subject & vbCrLf & oAppointmentItem.start & vbCrLf & oAppointmentItem.End & vbCrLf & vbCrLf

      'displayText = displayText & oAppointmentItem.Subject

    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

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetFutureOutlookEvents" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit

    outlookDates = False
End Function

标签： excelvbaoutlook

解决方案

您的限制应该有两个部分 -Start > today's midnight和Start < tomorrow's midnight。你只有第一部分。

另请记住，如果您想要重复活动的实例（而不仅仅是主约会），您需要使用该Items.IncludeRecurrences属性 - 请参阅https://docs.microsoft.com/en-us/office/vba/api/ outlook.items.includerecurrences

推荐阅读