如何從 Excel 中的給定日期獲取 Outlook 約會

Question

我想在 MessageBox 中顯示給定日期的 Outlook 日歷約會。 不幸的是，我使用的代碼沒有顯示今天的任何約會。 如果我將代碼更改為sfilter = "[Start] >= '" & startDate & "' "那么我會得到今天的約會以及其他日期的所有未來約會。 我只想顯示指定日期的約會。

日期選擇來自名為cmDates.srtDate.Value的UserForm

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

Answer 1

您的限制應該有兩部分 - Start > today's midnight和Start < tomorrow's midnight 。 你只有第一部分。

另請記住，如果您想要重復活動的實例（而不僅僅是主約會），則需要使用Items.IncludeRecurrences屬性 - 請參閱https://docs.microsoft.com/en-us/office/vba /api/outlook.items.includerecurrences

Answer 2

有幾個方面：

1. 要從滿足預定義條件的文件夾中檢索所有 Outlook 約會項目，您需要按升序對項目進行排序並將IncludeRecurrences設置為 true。 如果您在使用Restrict方法之前不這樣做，您將無法捕捉重復約會！
2. 如果您設置了IncludeRecurrences屬性，Microsoft 不建議使用Count屬性。 Count屬性可能會返回意外結果並導致無限循環。
3. 盡管日期和時間通常以Date格式存儲，但Find和Restrict方法要求將日期和時間轉換為字符串表示形式。 要確保日期格式符合 Microsoft Outlook 的要求，請使用 VBA 中提供的Format功能。 因此，您必須以 Outlook 理解的格式指定日期。

     Format(youDate, "ddddd h:nn AMPM")

例如，這是一個示例 VB.NET 代碼：

Imports System.Text
Imports System.Diagnostics
' ...
Private Sub RestrictCalendarItems(folder As Outlook.MAPIFolder)
    Dim dtEnd As DateTime = New DateTime(DateTime.Now.Year, DateTime.Now.Month, _
                                         DateTime.Now.Day, 23, 59, 0, 0)
    Dim restrictCriteria As String = "[Start]<=""" + dtEnd.ToString("g") + """" + _
                                     " AND [End]>=""" + DateTime.Now.ToString("g") + """"
    Dim strBuilder As StringBuilder = Nothing
    Dim folderItems As Outlook.Items = Nothing
    Dim resultItems As Outlook.Items = Nothing
    Dim appItem As Outlook._AppointmentItem = Nothing
    Dim counter As Integer = 0
    Dim item As Object = Nothing
    Try
        strBuilder = New StringBuilder()
        folderItems = folder.Items
        folderItems.IncludeRecurrences = True
        folderItems.Sort("[Start]")
        resultItems = folderItems.Restrict(restrictCriteria)
        item = resultItems.GetFirst()
        Do
            If Not IsNothing(item) Then
                If (TypeOf (item) Is Outlook._AppointmentItem) Then
                    counter = counter + 1
                    appItem = item
                    strBuilder.AppendLine("#" + counter.ToString() + _
                                          " Start: " + appItem.Start.ToString() + _
                                          " Subject: " + appItem.Subject + _
                                          " Location: " + appItem.Location)
                End If
                Marshal.ReleaseComObject(item)
                item = resultItems.GetNext()
            End If
        Loop Until IsNothing(item)
        If (strBuilder.Length > 0) Then
            Debug.WriteLine(strBuilder.ToString())
        Else
            Debug.WriteLine("There is no match in the " _
                             + folder.Name + " folder.")
        End If
    catch ex As Exception
        System.Windows.Forms.MessageBox.Show(ex.Message)
    Finally
        If Not IsNothing(folderItems) Then Marshal.ReleaseComObject(folderItems)
        If Not IsNothing(resultItems) Then Marshal.ReleaseComObject(resultItems)
    End Try
End Sub

您可能會發現以下文章很有幫助：

• 如何：在 Outlook 中使用 Restrict 方法獲取日歷項目
• 如何：使用 Find 和 FindNext 方法檢索 Outlook 日歷項目