快速迭代Outlook约会项目

Question

我已经编写了一个宏，它可以遍历用户的日历，并对满足特定条件的条目进行修改。

问题是，当日历非常大时，这需要很长时间。我似乎无法过滤约会，因为oAppointmentItems似乎会按创建时的顺序存储条目--顺序不一定与开始时相同。

我使用的代码是这样的：

Dim oOL As New Outlook.Application
Dim oNS As Outlook.NameSpace
Dim oAppointments As Object
Dim oAppointmentItem As Outlook.AppointmentItem

Set oNS = oOL.GetNamespace("MAPI")
Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)

For Each oAppointmentItem In oAppointments.Items

    DoEvents
    ' Something here
Next

Set oAppointmentItem = Nothing
Set oAppointments = Nothing
Set oNS = Nothing
Set oOL = Nothing

除了删除DoEvents (这只意味着Outlook似乎锁定了用户)，有没有什么方法可以通过应用某种过滤器来加快速度？例如，将来开始的约会。

Answer 1

您可以使用Restrict进行过滤。请注意，日期的格式为月、日、年，并且它们被筛选为字符串，即使存储为日期：

Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")

Set olRecItems = olNS.GetDefaultFolder(olFolderTasks)
strFilter = "[DueDate] > '1/15/2009'"
Set olFilterRecItems = olRecItems.Items.Restrict(strFilter)


For i = 1 To olFilterRecItems.Count
  <...>

更多信息：http://msdn.microsoft.com/en-us/library/bb220369.aspx

Answer 2

嘿，无法让任务工作，但这似乎可以在约会full explaination上工作

Dim myStart As Date
Dim myEnd As Date

myStart = Date
myEnd = DateAdd("d", 30, myStart)

Debug.Print "Start:", myStart
Debug.Print "End:", myEnd

'Construct filter for the next 30-day date range
strRestriction = "[Start] >= '" & _
Format$(myStart, "mm/dd/yyyy hh:mm AMPM") _
& "' AND [End] <= '" & _
Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") & "'"
'Check the restriction string
Debug.Print strRestriction

Const olFolderCalendar = 9
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")

Set oCalendar = olNS.GetDefaultFolder(olFolderTasks)

Set oItems = oCalendar.items
oItems.IncludeRecurrences = True
' oItems.Sort "[Start]" ' commented out  worked for me.. 
'Restrict the Items collection for the 30-day date range
Set oItemsInDateRange = oItems.Restrict(strRestriction)
Debug.Print oItemsInDateRange.Count