vba 快速迭代 Outlook 约会项目
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/1927799/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Iterating quickly through Outlook appointment items
提问by Richard
I've written a macro which iterates through a users calendar and makes modifications to entries that fufil a certain critera.
我编写了一个宏，它遍历用户日历并对符合特定标准的条目进行修改。
The problem is that when the calendar is very big, this takes a long time to do. I don't seem to be able to filter the appointments because oAppointmentItemsseems to store entries as they were created - which is not necessarily the same order as when they start.
问题是当日历很大时，这需要很长时间才能完成。我似乎无法过滤约会，因为oAppointmentItems似乎在创建条目时存储条目 - 这不一定与它们开始时的顺序相同。
The code I'm using is this:
我正在使用的代码是这样的：
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
Short of removing the DoEvents(which only means that Outlook appears to lock up to the user) is there any way I can speed this up by applying some kind of filter? For example, appointments which start in the future.
除了删除DoEvents（这仅意味着 Outlook 似乎对用户锁定）之外，我是否可以通过应用某种过滤器来加快速度？例如，在未来开始的约会。
回答by Fionnuala
You can use Restrict to filter. Note that dates are in the format month, day, year and that they are filtered as strings, even though stored as dates:
您可以使用 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
<...>
More information: http://msdn.microsoft.com/en-us/library/bb220369.aspx
回答by ozmike
Hey couldn't get tasks to work but this seem to work on appointments 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
