Lặp lại nhanh chóng thông qua các mục cuộc hẹn Outlook

Question

Tôi đã viết macro lặp qua lịch người dùng và thực hiện sửa đổi các mục nhập fufil một critera nhất định.

Vấn đề là khi lịch là rất lớn, điều này mất một thời gian dài để làm. Tôi dường như không thể lọc các cuộc hẹn vì oAppointmentItems dường như lưu trữ các mục nhập khi chúng được tạo - không nhất thiết phải giống như khi chúng bắt đầu.

Mã Tôi đang sử dụng là:

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 

ngắn loại bỏ các DoEvents (mà chỉ có nghĩa là Outlook dường như bị khóa cho người sử dụng) là có cách nào tôi có thể tăng tốc độ này lên bằng cách áp dụng một số loại bộ lọc? Ví dụ, các cuộc hẹn bắt đầu trong tương lai.

Answer 1

Bạn có thể sử dụng Hạn chế để lọc. Lưu ý rằng ngày có định dạng tháng, ngày, năm và họ được lọc như dây đàn, mặc dù được lưu trữ như ngày:

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 
    <...> 

Thông tin thêm: http://msdn.microsoft.com/en-us/library/bb220369.aspx

Answer 2

Hey không thể nhận được nhiệm vụ để làm việc nhưng điều này dường như hoạt động theo các cuộc hẹn 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