Thanks Sue,
I tried it hopefully but it does not solve the problem:
Sub CreateAppointments(ByVal lngFrom As Long, ByVal lngTo As Long)
Dim objAppointments As Outlook.Items
Dim objContacts As Outlook.Items
Dim objContact As Outlook.ContactItem
Dim objApp As Outlook.AppointmentItem
Dim lngIndex As Long
Set objContacts =
Outlook.Session.GetDefaultFolder(olFolderContacts) .Items
Set objAppointments =
Outlook.Session.GetDefaultFolder(olFolderCalendar) .Items
For lngIndex = lngFrom To lngTo
Set objContact = objContacts(lngIndex)
Set objApp = objAppointments.Add
With objApp
.ReminderSet = False
.Start = objContact.Birthday
.Subject = objContact.Subject
Call .Links.Add(objContact)
.Save
End With
Set objApp = Nothing
Set objContact = Nothing
Next
End Sub
I´m testing in virtual machines - may be this could be a problem? Does
the code runs on your machine (OL 2002/Exchange 2003)?
Here some code to create testing contacts:
Sub CreateContacts()
Dim objFolder As Outlook.MAPIFolder
Dim objContact As Outlook.ContactItem
Dim lngItem As Long
Set objFolder = Outlook.ActiveExplorer.CurrentFolder
For lngItem = 1 To 500
Set objContact = Outlook.CreateItem(olContactItem)
With objContact
.FirstName = "Test"
.LastName = lngItem
.Save
End With
Set objContact = Nothing
Next
Set objFolder = Nothing
End Sub
Peter
On 5 Nov., 14:47, "Sue Mosher [MVP-Outlook]"
wrote:
Try explicitly returning objContacts(lngIndex) so you can explicitly release it:
Set objContact = objContacts(lngIndex)
.Subject = objContact
Call .Links.Add(objContact)
Set objContact = Nothing
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54
"Peter Marchert" wrote in oglegroups.com...
Thanks for your reply, Dmitry.
I change my code to:
Sub CreateAppointments(ByVal lngFrom As Long, ByVal lngTo As Long)
Dim objAppointments As Outlook.Items
Dim objContacts As Outlook.Items
Dim objApp As Outlook.AppointmentItem
Dim lngIndex As Long
Set objContacts =
Outlook.Session.GetDefaultFolder(olFolderContacts) .Items
Set objAppointments =
Outlook.Session.GetDefaultFolder(olFolderCalendar) .Items
For lngIndex = lngFrom To lngTo
Set objApp = objAppointments.Add
With objApp
.ReminderSet = False
.Subject = objContacts(lngIndex).Subject
Call .Links.Add(objContacts(lngIndex))
.Save
End With
Set objApp = Nothing
Next
End Sub
But that makes no difference. What else could be the problem? Please
remember that the code works without the line
"Call .Links.Add(objContacts(lngIndex))". Can it even be the 255 items
problem?
Peter
On 5 Nov., 07:24, "Dmitry Streblechenko" wrote:
You are running out of 255 open messages limit imposed by Exchange in the
online mode.
Do not use multiple dot notation (to avoid implicit variables created by the
compiler) and immediately release all COM objects after using them:
set objItems = objCalendar.Items
For lngIndex = lngFrom To lngTo
Set objApp = objItems .Add
With objApp
.ReminderSet = False
.Subject = objContacts(lngIndex).Subject
Call .Links.Add(objContacts(lngIndex))
.Save
End With
Set objApp = Nothing
Next
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
"Peter Marchert" wrote in message
groups.com...
Hello,
I try to create hundreds of appointments in the calendar with a link
to a contact.
This works without problems on pst stores. With exchange mailboxes it
works too in OL 2003 but in 2002 on the 247th item the following error
occurs:
run time error -284147707 (ef104005)
error when executing the operation
This message is translated from German because I have no English 2002.
The numbers are different from time to time. In the compiled add-in I
get the message "-2147467259: Automation Error Unknown Error".
Here is the used code:
Sub Test()
Call CreateAppointments(1, 230)
Call CreateAppointments(231, 500)
End Sub
Sub CreateAppointments(ByVal lngFrom As Long, ByVal lngTo As Long)
Dim objCalendar As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objApp As Outlook.AppointmentItem
Dim lngIndex As Long
Set objContacts =
Outlook.Session.GetDefaultFolder(olFolderContacts) .Items
Set objCalendar =
Outlook.Session.GetDefaultFolder(olFolderCalendar)
For lngIndex = lngFrom To lngTo
Set objApp = objCalendar.Items.Add
With objApp
.ReminderSet = False
.Subject = objContacts(lngIndex).Subject
Call .Links.Add(objContacts(lngIndex))
.Save
End With
Next
End Sub
The error occurs on the line "Call .Links.Add(objContacts(lngIndex))"
and if I press after the error message F5 the code will run for the
next 246 items and will stop then again. Without the Link.Add method
the code runs without any errors.
Maybe this is an Outlook bug, but may be some one knows a workarround.
Thanks for any help and/or suggestions.
Peter- Zitierten Text ausblenden -
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
- Zitierten Text anzeigen -