Error when creating 247 appointments in exchange mailbox

  • Thread starter Thread starter Peter Marchert
  • Start date Start date
P

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
 
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:
 
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, 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.
Click to expand...

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
 
Try explicitly returning objContacts(lngIndex) so you can explicitly release it:

Set objContact = objContacts(lngIndex)
.Subject = objContact
Call .Links.Add(objContact)
Set objContact = Nothing
 
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
 
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

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
 
You are still using multiple dot notation (.Links.Add)
What happens if you comment out that line?
Click to expand...

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
 
Thank you Dmitry.

The code grows and grows:

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 objLink As Outlook.Link
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
Set objLink = colLinks.Add(objContact)
.Save
End With
Set objLink = Nothing
Set colLinks = Nothing
Set objApp = Nothing
Set objContact = Nothing
Next

End Sub

But the error still remains. Any other ideas?

Peter
 
And if you call the method in different block sizes, say, 100 or less, does
always the same one item cause the error? What happens then if you delete or
skip that one item?

--
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 Mon, 05 Nov 2007 21:51:23 -0800 schrieb Peter Marchert:
 
Hello Michael,

the items are all ok and nearly the same. They are called "Test 1",
"Test 2" and so on.

If I call the same procedure with a stop:

Sub Test()
Call CreateAppointments(1, 230)
Stop
Call CreateAppointments(231, 400)
End Sub

and then go on with F5 all is ok.

Peter
 
Found out something more:

OL 2000 / Ex 2003 same result
OL 2003 (without cache mode) / Ex 2003 same result
OL 2003 (cache mode) / Ex 2003 works

Must be a problem on the server. I installed the Windows 2003 Server
(SP2) with Exchange 2003 (SP? - I think I installed SP2, but I cannot
find any information about) on a virtual pc not a virtual server (its
only a testing system). Can anybody reproduce the error or confirm
that this works fine on his/her machine?

Peter
 
Yes, that is the problem. I increased the values for "objtMessage" to
350 and now the error occurs on the 347th item.

If I comment the line out it works without an error.

What can I do?

Peter

It is not a server problem, it is a server *feature* - seehttp://support.microsoft.com/kb/830829
So the code works fine if you comment out the

Set objLink = colLinks.Add(objContact)

line, rigth?

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




Found out something more:
Click to expand...
OL 2000 / Ex 2003 same result
OL 2003 (without cache mode) / Ex 2003 same result
OL 2003 (cache mode) / Ex 2003 works
Click to expand...
Must be a problem on the server. I installed the Windows 2003 Server
(SP2) with Exchange 2003 (SP? - I think I installed SP2, but I cannot
find any information about) on a virtual pc not a virtual server (its
only a testing system). Can anybody reproduce the error or confirm
that this works fine on his/her machine?
Peter
Click to expand...

Hello Michael,
the items are all ok and nearly the same. They are called "Test 1",
"Test 2" and so on.
If I call the same procedure with a stop:
Sub Test()
Call CreateAppointments(1, 230)
Stop
Call CreateAppointments(231, 400)
End Sub
and then go on with F5 all is ok.
Peter
On 6 Nov., 07:45, "Michael Bauer [MVP - Outlook]" <[email protected]>
wrote:
And if you call the method in different block sizes, say, 100 or less,
does
always the same one item cause the error? What happens then if you
delete or
skip that one item?
--
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 Mon, 05 Nov 2007 21:51:23 -0800 schrieb Peter Marchert:
Thank you Dmitry.
The code grows and grows:
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 objLink As Outlook.Link
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
Set objLink = colLinks.Add(objContact)
.Save
End With
Set objLink = Nothing
Set colLinks = Nothing
Set objApp = Nothing
Set objContact = Nothing
Next
End Sub
But the error still remains. Any other ideas?
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

On 5 Nov., 18:12, "Dmitry Streblechenko" <[email protected]>
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- Zitierten Text ausblenden -
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
Click to expand...
Click to expand...

- Zitierten Text anzeigen -
Click to expand...
 
What happens if you move the "with" block to a separate sub (that would
release all internal variables when the sub exits):

sub AddAppointment(objContact)
Set objApp = objAppointments.Add
Set colLinks = objApp.Links
With objApp
.ReminderSet = False
.Subject = objContact.Subject
Set objLink = colLinks.Add(objContact)
.Save
End With
Set objLink = Nothing
Set colLinks = Nothing
Set objApp = Nothing
end sub

For lngIndex = lngFrom To lngTo
Set objContact = objContacts(lngIndex)
AddAppointment(objContact)
Set objContact = Nothing
Next



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


Peter Marchert said:
Yes, that is the problem. I increased the values for "objtMessage" to
350 and now the error occurs on the 347th item.

If I comment the line out it works without an error.

What can I do?

Peter

It is not a server problem, it is a server *feature* -
seehttp://support.microsoft.com/kb/830829
So the code works fine if you comment out the

Set objLink = colLinks.Add(objContact)

line, rigth?

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




Found out something more:
Click to expand...
OL 2000 / Ex 2003 same result
OL 2003 (without cache mode) / Ex 2003 same result
OL 2003 (cache mode) / Ex 2003 works
Click to expand...
Must be a problem on the server. I installed the Windows 2003 Server
(SP2) with Exchange 2003 (SP? - I think I installed SP2, but I cannot
find any information about) on a virtual pc not a virtual server (its
only a testing system). Can anybody reproduce the error or confirm
that this works fine on his/her machine?

Hello Michael,
Click to expand...
the items are all ok and nearly the same. They are called "Test 1",
"Test 2" and so on.
Click to expand...
If I call the same procedure with a stop:
Click to expand...
Sub Test()
Call CreateAppointments(1, 230)
Stop
Call CreateAppointments(231, 400)
End Sub
Click to expand...
and then go on with F5 all is ok.
Peter
Click to expand...

On 6 Nov., 07:45, "Michael Bauer [MVP - Outlook]" <[email protected]>
wrote:
Click to expand...
And if you call the method in different block sizes, say, 100 or
less,
does
always the same one item cause the error? What happens then if you
delete or
skip that one item?
Click to expand...
--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Synchronize Color Categories & Ensure that Every Item Gets
Categorized:

Am Mon, 05 Nov 2007 21:51:23 -0800 schrieb Peter Marchert:
Click to expand...
Thank you Dmitry.
Click to expand...
The code grows and grows:
Click to expand...
Sub CreateAppointments(ByVal lngFrom As Long, ByVal lngTo As Long)
Click to expand...
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 objLink As Outlook.Link
Dim lngIndex As Long
Click to expand...
Set objContacts =
Outlook.Session.GetDefaultFolder(olFolderContacts).Items
Set objAppointments =
Outlook.Session.GetDefaultFolder(olFolderCalendar).Items
Click to expand...
For lngIndex = lngFrom To lngTo
Set objContact = objContacts(lngIndex)
Set objApp = objAppointments.Add
Set colLinks = objApp.Links
With objApp
.ReminderSet = False
.Subject = objContact.Subject
Set objLink = colLinks.Add(objContact)
.Save
End With
Set objLink = Nothing
Set colLinks = Nothing
Set objApp = Nothing
Set objContact = Nothing
Next
Click to expand...
End Sub
Click to expand...
But the error still remains. Any other ideas?

On 5 Nov., 21:57, "Dmitry Streblechenko" <[email protected]>
wrote:
Links.Add returns a Link object, which your code does not
reference
and
hence cannot release:
Click to expand...
set Link = .Links.Add ...
set Link = Nothing
Click to expand...
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
Click to expand...
On 5 Nov., 18:12, "Dmitry Streblechenko" <[email protected]>
wrote:
You are still using multiple dot notation (.Links.Add)
What happens if you comment out that line?
Click to expand...
If the line is commented out the code works fine. I tried this
one:
Click to expand...
Sub CreateAppointments(ByVal lngFrom As Long, ByVal lngTo As
Long)
Click to expand...
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
Click to expand...
Set objContacts =
Outlook.Session.GetDefaultFolder(olFolderContacts).Items
Set objAppointments =
Outlook.Session.GetDefaultFolder(olFolderCalendar).Items
Click to expand...
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
Click to expand...
End Sub
Click to expand...
But the error comes back.
Click to expand...
Peter- Zitierten Text ausblenden -
Click to expand...
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
Click to expand...
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
Click to expand...
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
Click to expand...

- Zitierten Text anzeigen -
Click to expand...
Click to expand...
 
Thank you Dmitry, but the error is still there:

Sub Test()
Call CreateAppointments(1, 230)
Call CreateAppointments(231, 400)
End Sub

Sub CreateAppointments(ByVal lngFrom As Long, ByVal lngTo As Long)

Dim objContacts As Outlook.Items
Dim objContact As Outlook.ContactItem
Dim lngIndex As Long

Set objContacts =
Outlook.Session.GetDefaultFolder(olFolderContacts).Items

For lngIndex = lngFrom To lngTo
Set objContact = objContacts(lngIndex)
Call AddAppointment(objContact)
Set objContact = Nothing
Next

End Sub

Sub AddAppointment(ByVal objContact As Outlook.ContactItem)

Dim objAppointments As Outlook.Items
Dim objApp As Outlook.AppointmentItem
Dim colLinks As Outlook.Links
Dim objLink As Outlook.Link

Set objAppointments =
Outlook.Session.GetDefaultFolder(olFolderCalendar).Items

Set objApp = objAppointments.Add
Set colLinks = objApp.Links
With objApp
.ReminderSet = False
.Subject = objContact.Subject
Set objLink = colLinks.Add(objContact)
.Save
End With
Set objLink = Nothing
Set colLinks = Nothing
Set objApp = Nothing
Set objContact = Nothing

End Sub

Peter

What happens if you move the "with" block to a separate sub (that would
release all internal variables when the sub exits):

sub AddAppointment(objContact)
Set objApp = objAppointments.Add
Set colLinks = objApp.Links
With objApp
.ReminderSet = False
.Subject = objContact.Subject
Set objLink = colLinks.Add(objContact)
.Save
End With
Set objLink = Nothing
Set colLinks = Nothing
Set objApp = Nothing
end sub

For lngIndex = lngFrom To lngTo
Set objContact = objContacts(lngIndex)
AddAppointment(objContact)
Set objContact = Nothing
Next

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




Yes, that is the problem. I increased the values for "objtMessage" to
350 and now the error occurs on the 347th item.
Click to expand...
If I comment the line out it works without an error.
Click to expand...
What can I do?
Peter
Click to expand...

It is not a server problem, it is a server *feature* -
seehttp://support.microsoft.com/kb/830829
So the code works fine if you comment out the
Set objLink = colLinks.Add(objContact)
line, rigth?
Dmitry Streblechenko (MVP)http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Found out something more:
OL 2000 / Ex 2003 same result
OL 2003 (without cache mode) / Ex 2003 same result
OL 2003 (cache mode) / Ex 2003 works
Must be a problem on the server. I installed the Windows 2003 Server
(SP2) with Exchange 2003 (SP? - I think I installed SP2, but I cannot
find any information about) on a virtual pc not a virtual server (its
only a testing system). Can anybody reproduce the error or confirm
that this works fine on his/her machine?
Peter
Hello Michael,
the items are all ok and nearly the same. They are called "Test 1",
"Test 2" and so on.
If I call the same procedure with a stop:
Sub Test()
Call CreateAppointments(1, 230)
Stop
Call CreateAppointments(231, 400)
End Sub
and then go on with F5 all is ok.
Peter
On 6 Nov., 07:45, "Michael Bauer [MVP - Outlook]" <[email protected]>
wrote:
And if you call the method in different block sizes, say, 100 or
less,
does
always the same one item cause the error? What happens then if you
delete or
skip that one item?
--
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 Mon, 05 Nov 2007 21:51:23 -0800 schrieb Peter Marchert:
Thank you Dmitry.
The code grows and grows:
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 objLink As Outlook.Link
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
Set objLink = colLinks.Add(objContact)
.Save
End With
Set objLink = Nothing
Set colLinks = Nothing
Set objApp = Nothing
Set objContact = Nothing
Next
End Sub
But the error still remains. Any other ideas?
Peter
On 5 Nov., 21:57, "Dmitry Streblechenko" <[email protected]>
wrote:
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

On 5 Nov., 18:12, "Dmitry Streblechenko" <[email protected]>
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- Zitierten Text ausblenden -
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
- Zitierten Text anzeigen -- Zitierten Text ausblenden -
Click to expand...
Click to expand...

- Zitierten Text anzeigen -
Click to expand...
 
Peter, see if this is any better:

Public objContacts As Outlook.Items
Public objContact As Outlook.ContactItem

Public objAppointments As Outlook.Items

Public objApp As Outlook.AppointmentItem
Public colLinks As Outlook.Links
Public objLink As Outlook.Link

Sub Test()
Dim oNS As Outlook.NameSpace

Set oNS = Outlook.GetNameSpace("MAPI")

Set objContacts = _
oNS.GetDefaultFolder(olFolderContacts).Items

Set objAppointments = _
oNS.GetDefaultFolder(olFolderCalendar).Items

Call CreateAppointments(1, 230)
Call CreateAppointments(231, 400)

Set objContacts = Nothing
Set objContact = Nothing

Set objAppointments = Nothing

Set objApp = Nothing
Set colLinks = Nothing
Set objLink = Nothing
End Sub

Sub CreateAppointments(ByVal lngFrom As Long, ByVal lngTo As Long)
Dim lngIndex As Long

For lngIndex = lngFrom To lngTo
Set objContact = objContacts.Item(lngIndex)
Call AddAppointment(objContact)
Set objContact = Nothing
Next
End Sub

Sub AddAppointment(ByVal objContact As Outlook.ContactItem)
Set objApp = objAppointments.Add
Set colLinks = objApp.Links

With objApp
.ReminderSet = False
.Subject = objContact.Subject
Set objLink = colLinks.Add(objContact)
.Save
End With

Set objLink = Nothing
Set colLinks = Nothing
Set objApp = Nothing
End Sub
 
Back
Top