Itérer rapidement via les éléments de rendez-vous Outlook

Question

J'ai écrit une macro qui itère dans un calendrier utilisateur et apporte des modifications aux entrées qui satisfont certains critères.

Le problème est que lorsque le calendrier est très grand, cela prend beaucoup de temps. Je ne semble pas pouvoir filtrer les rendez-vous parce que oAppointmentItems semble stocker les entrées telles qu'elles ont été créées - ce qui n'est pas nécessairement le même ordre que lorsqu'elles commencent.

Le code J'utilise est ceci:

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 

court d'enlever la DoEvents (ce qui signifie que Outlook semble se bloquer à l'utilisateur) est-il possible que je peux accélérer ce en appliquant une sorte de filtre? Par exemple, les rendez-vous qui commencent dans le futur.

Answer 1

Vous pouvez utiliser Restreindre pour filtrer. Notez que les dates sont au format mois, jour, année et qu'ils sont filtrés sous forme de chaînes, même si stocké sous forme de dates:

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

Plus d'informations: http://msdn.microsoft.com/en-us/library/bb220369.aspx

Answer 2

Hey ne pouvait pas obtenir des tâches au travail, mais cela semble fonctionner sur rendez-vous 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