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

Question

我有一个按日期过滤日历约会的Excel宏。我使用了微软文档给出的代码，但它不起作用。我想迭代默认日历，以查找从今天到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年开始。它返回的最后一个约会符合过滤器(13/05/2021)。我试过不同的过滤器，但它总是返回相同的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