Cannot add > 247 items

[Boein]

Hi,

weird problem. I'm making a program that automaticaly adds contacts from a
asci-file into outlook using vbs. If I run my program the script crashes
adding a 247th item (contact addition). I checked this by adding a counter,
it doesn't matter if I delete some line from the ascii file, it alway crashes
at 247. It look like a buffer overflow. Even more strange this only happens
if I run the script filling contacts in my maibox-folder, if I run the same
script in my "personal-folder" there's no problem. The only difference
between the two mailbox folder is on the exchange server, personal folder is
a local pst. Is there a way to make this work without this limitation?

outlook client: 2003
Exchange server: 2007

Thanks
Boein

 

[Ken Slovak - [MVP - Outlook]]

By default RPC connection channels to the Exchange server are limited to a
maximum of 255 open channels. You aren't setting your objects to Nothing as
you pass through the loop, which you need to do. Set each Outlook object
reference = Nothing in the loop before you instantiate the next instance of
the object. Don't use a lot of dot operators, they create internal object
variables. Explicitly instantiate a new object reference for each dot
operator and set those to Nothing each pass through the loop.

 

[Boein]

Hi Ken,

Are you sure that's the reason because it crashes on the 247th item not the
255th. Nevertheless I changed the code but it doesn't help, maybe you can
check what's wrong in this code?
Thanks
Boein

sub Import_click()
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
("c:\import.txt", ForReading)
Set nms = Application.GetNameSpace("MAPI")
Set FormPage = Item.GetInspector.ModifiedFormPages("P.2")
strFolder = "test"
fFound = FindFolder(nms.Folders("Mailbox - test").folders("PZ").Folders, 0,
strFolder)
If fFound = True Then
Set fld = nms.Folders("Mailbox - test").folders("PZ").Folders(strFolder)
ElseIf fFound = False Then
Set fld = nms.Folders("Mailbox -
test").folders("PZ").Folders.Add(strFolder, olFolderContacts)
End If
Set itms = fld.Items
Do Until objTextFile.AtEndOfStream
set itm=nothing
strNextLine = objTextFile.Readline
arrServiceList = Split(strNextLine , ",")
n=fillvars(arrservicelist(0),0)
For i = 1 to Ubound(arrServiceList)
n=fillvars(arrservicelist(i),i)
Next
if itms.find("[Organizational ID Number] = '" & arrservicelist(0) & "'") is
nothing then
Set itm = itms.Add("IPM.Contact.PZ")
Else
end if
with itm
.firstname = FormPage.Controls("firstname").value
.userproperties("Organizational ID Number") =
FormPage.Controls("emplid").value
.close (olsave)
set itm = nothing
end with

Loop
end sub


Function fillvars(tab,nr)
tab= replace(tab,"""","")
tab=trim (tab)
Set FormPage = Item.GetInspector.ModifiedFormPages("P.2")
select case nr
case 0
Set Control = FormPage.Controls("emplid")
formPage.Controls("emplid").value=tab
case 2
Set Control = FormPage.Controls("firstname")
formPage.Controls("firstname").value=tab
end select
set control=nothing
End Function

 

[Ken Slovak - [MVP - Outlook]]

I'm positive that's the problem. Don't forget, you may have already opened
some RPC channels to Exchange even before your code starts running.

I don't see anything obvious in the code, see if this helps. Instead of
handling everything in one loop set up the code so that you call to do the
first 200 items, then the next, etc. until all are processed. Make sure your
function to process those 200 items is a separate function called from a
main function. See if that helps.

 

[Boein]

I cannot break the loop because the loop read a txt-file, the program will be
quite complicated to make to return to the last read txt-line in the file. Is
there anything I can do, it can't be that difficult reading a txt-file and
putting eac line in an outlook field.

Anybody ideas?

I'm positive that's the problem. Don't forget, you may have already opened
some RPC channels to Exchange even before your code starts running.

I don't see anything obvious in the code, see if this helps. Instead of
handling everything in one loop set up the code so that you call to do the
first 200 items, then the next, etc. until all are processed. Make sure your
function to process those 200 items is a separate function called from a
main function. See if that helps.

Hi Ken,

Are you sure that's the reason because it crashes on the 247th item not
the
255th. Nevertheless I changed the code but it doesn't help, maybe you can
check what's wrong in this code?
Thanks
Boein

sub Import_click()
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
("c:\import.txt", ForReading)
Set nms = Application.GetNameSpace("MAPI")
Set FormPage = Item.GetInspector.ModifiedFormPages("P.2")
strFolder = "test"
fFound = FindFolder(nms.Folders("Mailbox - test").folders("PZ").Folders,
0,
strFolder)
If fFound = True Then
Set fld = nms.Folders("Mailbox - test").folders("PZ").Folders(strFolder)
ElseIf fFound = False Then
Set fld = nms.Folders("Mailbox -
test").folders("PZ").Folders.Add(strFolder, olFolderContacts)
End If
Set itms = fld.Items
Do Until objTextFile.AtEndOfStream
set itm=nothing
strNextLine = objTextFile.Readline
arrServiceList = Split(strNextLine , ",")
n=fillvars(arrservicelist(0),0)
For i = 1 to Ubound(arrServiceList)
n=fillvars(arrservicelist(i),i)
Next
if itms.find("[Organizational ID Number] = '" & arrservicelist(0) & "'")
is
nothing then
Set itm = itms.Add("IPM.Contact.PZ")
Else
end if
with itm
.firstname = FormPage.Controls("firstname").value
.userproperties("Organizational ID Number") =
FormPage.Controls("emplid").value
.close (olsave)
set itm = nothing
end with

Loop
end sub


Function fillvars(tab,nr)
tab= replace(tab,"""","")
tab=trim (tab)
Set FormPage = Item.GetInspector.ModifiedFormPages("P.2")
select case nr
case 0
Set Control = FormPage.Controls("emplid")
formPage.Controls("emplid").value=tab
case 2
Set Control = FormPage.Controls("firstname")
formPage.Controls("firstname").value=tab
end select
set control=nothing
End Function

 

[Ken Slovak - [MVP - Outlook]]

If this is the RPC channel problem, and it looks like it is, the only things
to do are break the loop and/or release all Outlook objects each pass
through the loop. Since you're releasing them already about the only other
thing I can think of is to break up the loop into smaller pieces.

About the other thing I can think of would be to add some sort of time delay
between loop passes to give the RPC channels time to close if you can do
that. It might help.

 

[Boein]

Hi Ken,

I solved the problem. There's a registry key that fixes the problem (see KB
293797 Memory or Performance Problems Looping Through Items). Maybe it's not
the best way to solve problems but it sure helps.

Create the following DWORD registry key and set its value to a number
greater than 0: (0X00000020 works fine)
HKEY_LOCAL_MACHINE\Software\Microsoft\Office\10.0\Outlook\Scripting\Threshold


Kind regards
Boein