在日历中搜索某个时间段内的约会

Question

我有一个 Excel 宏，可以按日期过滤日历约会。我使用了Microsoft Docs 给出的代码，但它不起作用。我想迭代默认日历以查找今天和从今天起 30 天之间发生的约会。

这是代码：



Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Sub P1()
    Dim oOutlook              As Object
    Dim oNS                   As Object
    Dim oAppointments         As Object
    Dim oFilterAppointments   As Object
    Dim oAppointmentItem      As Object
    Dim bOutlookOpened        As Boolean
    Const olFolderCalendar = 9
    
    Dim sFilter As String
    Dim dateEnd As String
        
    
    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
 
    Set oNS = oOutlook.GetNamespace("MAPI")
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
    
    oAppointments.Sort [Start]

    oAppointments.IncludeRecurrences = True
    
    
    dateEnd = DateAdd("d", 30, Date)
   
    sFilter = "[Start] >= '" & Date & " 'AND [Start] <= '" & dateEnd & "'"

    Debug.Print sFilter


    Set oFilterAppointments = oAppointments.Items.Restrict(sFilter)

    
    'Iterate through each appt in our calendar
    For Each oAppointmentItem In oFilterAppointments
        Debug.Print oAppointmentItem.Start

    Next


End Sub

今天的过滤限制是 [Start] >= '03/02/2021 'AND [Start] <= '14/05/2021 但找到的第一个约会是从 2019 年开始的。它 returns 符合过滤器 (13/05/2021) 的最后一个约会。我尝试了不同的过滤器变体，但它总是 returns 2019 年的相同约会。

Answer 1

我发现日期差异很小，因此您的情况可能存在更多差异。

.Sort 在 .Restrict.

之前

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Sub P1()
    
    Dim oAppointments         As Items
    Dim oFilterAppointments   As Items
    Dim oAppointmentItem      As AppointmentItem
    
    Dim sFilter As String
    Dim dateEnd As Date
    
    Set oAppointments = Session.GetDefaultFolder(olFolderCalendar).Items
    
    ' .Sort before .Restrict
    oAppointments.Sort "[Start]"
    oAppointments.IncludeRecurrences = True
    
    dateEnd = DateAdd("d", 30, Date)
    sFilter = "[Start] >= '" & Date & " 'AND [Start] <= '" & dateEnd & "'"
    Debug.Print sFilter

    Set oFilterAppointments = oAppointments.Restrict(sFilter)
   
    'Iterate through filtered appointments
    For Each oAppointmentItem In oFilterAppointments
        Debug.Print oAppointmentItem.Start
    Next
    
End Sub

在日历中搜索某个时间段内的约会

Search the calendar for appointments in a time period

outlook

vba