通过Outlook VBA仅获取今天的约会

OP留下了一条评论,表示 Restrict 是有效的。

“…关于IncludeRecurrences的文档链接…提到 .Sort 需要按升序完成”

这是可能的 .Restrict 不适合此任务。

使用示例 .Find .

项目。IncludeRecurrences属性(Outlook) https://learn.microsoft.com/en-us/office/vba/api/outlook.items.includerecurrences

Sub DemoFindNext()

    ' https://learn.microsoft.com/en-us/office/vba/api/outlook.items.includerecurrences

    Dim myNameSpace As Outlook.NameSpace
    Dim tdystart As Date
    Dim tdyend As Date
    Dim myAppointments As Outlook.Items
    Dim currentAppointment As Outlook.AppointmentItem
 
    Set myNameSpace = Application.GetNamespace("MAPI")
    
    tdystart = VBA.Format(Now, "Short Date")
    tdyend = VBA.Format(Now + 1, "Short Date")
 
    Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
 
    myAppointments.Sort "[Start]"
 
    myAppointments.IncludeRecurrences = True
 
    Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
 
    While TypeName(currentAppointment) <> "Nothing"
        Debug.Print currentAppointment.Subject
        ' MsgBox currentAppointment.Subject
        Set currentAppointment = myAppointments.FindNext
    Wend

End Sub

微软不建议使用 Count 如果您设置了 IncludeRecurrences 财产。这个 计数 属性可能会返回意外结果并导致无限循环。在 How To: Use Restrict method in Outlook to get calendar items 文章。

这是一个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