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