creating calendar items VERY slow

  • Thread starter Thread starter Al Blake
  • Start date Start date
A

Al Blake

I hope this is the correct forum - if not please direct me elsewhere. We
have a programme that creates hundreds of calendar entries automatically in
resource calendars (Exchange2003). The programme accesses the claendars
though MAPI. The problem is that the programme is VERY slow - like often a
minute or more to create an entry; with 900+ entries that is a long time.
The mail systems itself is snappy and performs well so I am convinced the
problem is in the vb code and/or MAPI interface.

The code is below (I know it's scrappy). Cna anyone see any obvious bad
coding issues that would cuase MAPI to grind?
Suggestions welcome.
Al Blake.

========================================================================================
Do While Not .EOF
Set olns = ol.GetNamespace("MAPI")
strRecipient = .Fields("RECIPIENT")
strCategory = .Fields("CATEGORIES")
' Now process the recipient room
Debug.Print "Processing " & strRecipient & " - " & strCategory
Set Recipient = olns.CreateRecipient(strRecipient)
=>> The next line takes a few seconds; we expect that =>
Recipient.Resolve
If Recipient.Resolved Then
Set calendar = olns.GetSharedDefaultFolder(Recipient,
olFolderCalendar)
Set rst = CurrentDb.OpenRecordset("Select * from qryuvTTExport
where Recipient='" & strRecipient & "' AND Categories ='" & strCategory &
"'")
Else
MsgBox ("Could not resolve recipient " & strRecipient)
Stop
End If
' Now create each calendar entry
' Erase existing calendar records with the same category
Set items = calendar.items
Set restrictitems = items.Restrict("[Categories] = " & strCategory)
Do While restrictitems.Count > 0
For Each item In restrictitems
item.Delete
Next
Set restrictitems = items.Restrict("[Categories] = " & strCategory)
Loop
Set restrictitems = Nothing
Set items = Nothing
With rst
.MoveFirst
==> This loop takes a *long* time to execute (often several minutes per
loop)
Do While Not .EOF
' Read each record
Set item = calendar.items.Add
Count = Count + 1
Debug.Print "Item " & Count & " Category: " &
..Fields("Categories") & " Recipient: " & strRecipient
item.Subject = .Fields("SUMMARY")
item.Start = .Fields("dtstart")
item.End = .Fields("dtend")
item.Location = .Fields("room")
item.Categories = .Fields("Categories") & ";" &
..Fields("room")
Set itemrec = item.GetRecurrencePattern
itemrec.RecurrenceType = olRecursDaily
itemrec.Interval = 14
itemrec.PatternEndDate = .Fields("UNTIL")
item.Save
Set item = Nothing
Set itemrec = Nothing
.MoveNext
Loop
End With
Set olns = Nothing
.MoveNext
Loop
 
The slowdown could be due to all those Restricts that you'e applying. Outlook caches restrictions and so every time you add an item, Outlook is also updated all those filters. Usually, it's a problem we see with public folders. The article at http://support.microsoft.com/?kbid=216076 describes this issue.

Using Items.Find and FindNext instead of Restrict would avoid the cached restriction issue. The slightly longer time to delete could be well outweighed by much shorter time to add.

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



Al Blake said:
I hope this is the correct forum - if not please direct me elsewhere. We
have a programme that creates hundreds of calendar entries automatically in
resource calendars (Exchange2003). The programme accesses the claendars
though MAPI. The problem is that the programme is VERY slow - like often a
minute or more to create an entry; with 900+ entries that is a long time.
The mail systems itself is snappy and performs well so I am convinced the
problem is in the vb code and/or MAPI interface.

The code is below (I know it's scrappy). Cna anyone see any obvious bad
coding issues that would cuase MAPI to grind?
Suggestions welcome.
Al Blake.

========================================================================================
Do While Not .EOF
Set olns = ol.GetNamespace("MAPI")
strRecipient = .Fields("RECIPIENT")
strCategory = .Fields("CATEGORIES")
' Now process the recipient room
Debug.Print "Processing " & strRecipient & " - " & strCategory
Set Recipient = olns.CreateRecipient(strRecipient)
=>> The next line takes a few seconds; we expect that =>
Recipient.Resolve
If Recipient.Resolved Then
Set calendar = olns.GetSharedDefaultFolder(Recipient,
olFolderCalendar)
Set rst = CurrentDb.OpenRecordset("Select * from qryuvTTExport
where Recipient='" & strRecipient & "' AND Categories ='" & strCategory &
"'")
Else
MsgBox ("Could not resolve recipient " & strRecipient)
Stop
End If
' Now create each calendar entry
' Erase existing calendar records with the same category
Set items = calendar.items
Set restrictitems = items.Restrict("[Categories] = " & strCategory)
Do While restrictitems.Count > 0
For Each item In restrictitems
item.Delete
Next
Set restrictitems = items.Restrict("[Categories] = " & strCategory)
Loop
Set restrictitems = Nothing
Set items = Nothing
With rst
.MoveFirst
==> This loop takes a *long* time to execute (often several minutes per
loop)
Do While Not .EOF
' Read each record
Set item = calendar.items.Add
Count = Count + 1
Debug.Print "Item " & Count & " Category: " &
.Fields("Categories") & " Recipient: " & strRecipient
item.Subject = .Fields("SUMMARY")
item.Start = .Fields("dtstart")
item.End = .Fields("dtend")
item.Location = .Fields("room")
item.Categories = .Fields("Categories") & ";" &
.Fields("room")
Set itemrec = item.GetRecurrencePattern
itemrec.RecurrenceType = olRecursDaily
itemrec.Interval = 14
itemrec.PatternEndDate = .Fields("UNTIL")
item.Save
Set item = Nothing
Set itemrec = Nothing
.MoveNext
Loop
End With
Set olns = Nothing
.MoveNext
Loop
Click to expand...
 
Back
Top