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

Peter, do you know for sure that there's no Distlist in the contacts folder?
Then I'd use a variable for the ContactItem because accessing objContacts(i)
twice creates two references.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Synchronize Color Categories & Ensure that Every Item Gets Categorized:
http://www.vboffice.net/product.html?id=2006063&cmd=detail&lang=en&pub=6

Am Sun, 04 Nov 2007 05:06:59 -0800 schrieb Peter Marchert:

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

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

On 5 Nov., 07:00, "Michael Bauer [MVP - Outlook]"
wrote:
Peter, do you know for sure that there's no Distlist in the contacts folder?
Then I'd use a variable for the ContactItem because accessing objContacts(i)
twice creates two references.

Moin, Michael,

thanks for your assistance. The used contact folder does not contain
distlists only testing contacts.

Peter

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

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

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

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

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 -

You are still using multiple dot notation (.Links.Add)
What happens if you comment out that line?

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

"Peter Marchert" wrote in message
ps.com...
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 -

On 5 Nov., 18:12, "Dmitry Streblechenko" wrote:
You are still using multiple dot notation (.Links.Add)
What happens if you comment out that line?

If the line is commented out the code works fine. I tried this one:

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 colLinks As Outlook.Links
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
Set colLinks = objApp.Links
With objApp
.ReminderSet = False
.Subject = objContact.Subject
Call colLinks.Add(objContact)
.Save
End With
Set colLinks = Nothing
Set objApp = Nothing
Set objContact = Nothing
Next

End Sub

But the error comes back.

Peter

Links.Add returns a Link object, which your code does not reference and
hence cannot release:

set Link = .Links.Add ...
set Link = Nothing

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

"Peter Marchert" wrote in message
ps.com...
On 5 Nov., 18:12, "Dmitry Streblechenko" wrote:
You are still using multiple dot notation (.Links.Add)
What happens if you comment out that line?

If the line is commented out the code works fine. I tried this one:

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 colLinks As Outlook.Links
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
Set colLinks = objApp.Links
With objApp
.ReminderSet = False
.Subject = objContact.Subject
Call colLinks.Add(objContact)
.Save
End With
Set colLinks = Nothing
Set objApp = Nothing
Set objContact = Nothing
Next

End Sub

But the error comes back.

Peter