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" 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

"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- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

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" 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

"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- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

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]"
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" 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

"Peter Marchert" wrote in message

oups.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- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

Found out something mo

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

On 6 Nov., 08:11, Peter Marchert wrote:
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]"
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" 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

"Peter Marchert" wrote in message

oups.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- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

It is not a server problem, it is a server *feature* - see
http://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

"Peter Marchert" wrote in message
ups.com...
Found out something mo

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

On 6 Nov., 08:11, Peter Marchert wrote:
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]"
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" 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

"Peter Marchert" wrote in message

oups.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- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

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

On 6 Nov., 18:54, "Dmitry Streblechenko" wrote:
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

"Peter Marchert" wrote in message

ups.com...



Found out something mo

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

On 6 Nov., 08:11, Peter Marchert wrote:
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]"
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" 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

"Peter Marchert" wrote in message

oups.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- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

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" wrote in message
oups.com...
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

On 6 Nov., 18:54, "Dmitry Streblechenko" wrote:
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

"Peter Marchert" wrote in message

ups.com...



Found out something mo

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

On 6 Nov., 08:11, Peter Marchert wrote:
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]"
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"
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

"Peter Marchert" wrote in message

oups.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- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

Thank you Dmitry, but the error is still the

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

On 6 Nov., 19:58, "Dmitry Streblechenko" wrote:
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" wrote in message

oups.com...



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

On 6 Nov., 18:54, "Dmitry Streblechenko" wrote:
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

"Peter Marchert" wrote in message

roups.com...

Found out something mo

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

On 6 Nov., 08:11, Peter Marchert wrote:
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]"
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"
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

"Peter Marchert" wrote in message

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

- Zitierten Text anzeigen -

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


--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Peter Marchert" wrote in message
oups.com...
Thank you Dmitry, but the error is still the

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

Thanks for your idea, Ken.

I`m sorry, but there is no change.

Peter

On 6 Nov., 21:47, "Ken Slovak - [MVP - Outlook]"
wrote:
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

--
Ken Slovak
[MVP - Outlook]http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Optionshttp://www.slovaktech.com/products.htm

"Peter Marchert" wrote in message

oups.com...



Thank you Dmitry, but the error is still the

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- Zitierten Text ausblenden -

- Zitierten Text anzeigen -