retrieving custom fields causing memory leaks/corruption?

J

James

I wrote a macro to extract contact information from a contact based
form and place it in an excel spreadsheet. Along with the standard
fields, I also want info from a couple of custom fields.

There's about 5000 entries........if I only export the standard fields
everything works fine. However if I try and grab info from the 2
custom fields after so many entries Outlook becomes corrupt - by that
I mean the wrong information starts getting returned and if you try
and open up any of the contacts from the folder I'm extracting info
from it tells you that the item can't be opened.

The one field is from a multiselect listbox of type keywords, the
other is a combo box of type text. I can get around 250 entries from
the listbox and around 500 from the combo (in separate tests). Again,
if I only retrieve the standard fields I can extract all 5000 entries
no problem.

I'm running Outlook 2002 SP2.

Most frustrated.

James

----------------------------------

Sub Export()

Dim objExcelApp
Dim objExcelBook
Dim objExcelSheets
Dim objExcelSheet
Dim objExcelRange
Dim objNS
Dim objFolder
Dim objContact
Dim objItems
Dim objRange
Dim objCounter
Dim objControl

On Error Resume Next

Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Application.Visible = False
objExcelApp.Application.Workbooks.Add
Set objExcelBook = objExcelApp.ActiveWorkbook
Set objExcelSheets = objExcelBook.Worksheets
Set objExcelSheet = objExcelBook.Sheets(1)
objExcelSheet.Activate

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.Folders("Public Folders").Folders("All Public
Folders").Folders("Sales Contacts")
Set objItems = objFolder.Items

objCounter = 3

objExcelSheet.Range("A1") = "First Name"
objExcelSheet.Range("B1") = "Last Name"
objExcelSheet.Range("C1") = "Company"
objExcelSheet.Range("D1") = "Job Title"
objExcelSheet.Range("E1") = "Street"
objExcelSheet.Range("F1") = "City"
objExcelSheet.Range("G1") = "Province"
objExcelSheet.Range("H1") = "Postal Code"
objExcelSheet.Range("I1") = "Business Phone"
objExcelSheet.Range("J1") = "Fax Number"

objExcelSheet.Range("L1") = "Function"

objExcelApp.Application.Visible = True

For Each Item In objItems

'Set objControl = Item.GetInspector.ModifiedFormPages("Sales
Info").Controls("ListBox1")

Set objRange = objExcelSheet.Range("A" & objCounter)
objRange.Value = Item.FirstName
Set objRange = objExcelSheet.Range("B" & objCounter)
objRange.Value = Item.LastName
Set objRange = objExcelSheet.Range("C" & objCounter)
objRange.Value = Item.CompanyName
Set objRange = objExcelSheet.Range("D" & objCounter)
objRange.Value = Item.JobTitle
Set objRange = objExcelSheet.Range("E" & objCounter)
objRange.Value = Item.BusinessAddressStreet
Set objRange = objExcelSheet.Range("F" & objCounter)
objRange.Value = Item.BusinessAddressCity
Set objRange = objExcelSheet.Range("G" & objCounter)
objRange.Value = Item.BusinessAddressState
Set objRange = objExcelSheet.Range("H" & objCounter)
objRange.Value = Item.BusinessAddressPostalCode
Set objRange = objExcelSheet.Range("I" & objCounter)
objRange.Value = Item.BusinessTelephoneNumber
Set objRange = objExcelSheet.Range("J" & objCounter)
objRange.Value = Item.BusinessFaxNumber

' //This is listbox
' Set objRange = objExcelSheet.Range("L" & objCounter)
' If objControl.Selected(6) = True Then
' objRange.Value = objControl.List(6) //Looking for a
certain entry
' Else
' objRange.Value = "Other"
' End If

' //This is combobox

Set objRange = objExcelSheet.Range("L" & objCounter)
objRange.Value = Item.UserProperties("Function")

objCounter = objCounter + 1
Next

' Clean up variables

Set objExcelApp = Nothing
Set objExcelBook = Nothing
Set objExcelSheets = Nothing
Set objExcelSheet = Nothing
Set objExcelRange = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objContact = Nothing
Set objItems = Nothing
Set objRange = Nothing
Set objCounter = Nothing
Set objControl = Nothing

End Sub
 
J

James

Can someone please offer any suggestions?

James

I wrote a macro to extract contact information from a contact based
form and place it in an excel spreadsheet. Along with the standard
fields, I also want info from a couple of custom fields.

There's about 5000 entries........if I only export the standard fields
everything works fine. However if I try and grab info from the 2
custom fields after so many entries Outlook becomes corrupt - by that
I mean the wrong information starts getting returned and if you try
and open up any of the contacts from the folder I'm extracting info
from it tells you that the item can't be opened.

The one field is from a multiselect listbox of type keywords, the
other is a combo box of type text. I can get around 250 entries from
the listbox and around 500 from the combo (in separate tests). Again,
if I only retrieve the standard fields I can extract all 5000 entries
no problem.

I'm running Outlook 2002 SP2.

Most frustrated.

James

----------------------------------

Sub Export()

Dim objExcelApp
Dim objExcelBook
Dim objExcelSheets
Dim objExcelSheet
Dim objExcelRange
Dim objNS
Dim objFolder
Dim objContact
Dim objItems
Dim objRange
Dim objCounter
Dim objControl

On Error Resume Next

Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Application.Visible = False
objExcelApp.Application.Workbooks.Add
Set objExcelBook = objExcelApp.ActiveWorkbook
Set objExcelSheets = objExcelBook.Worksheets
Set objExcelSheet = objExcelBook.Sheets(1)
objExcelSheet.Activate

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.Folders("Public Folders").Folders("All Public
Folders").Folders("Sales Contacts")
Set objItems = objFolder.Items

objCounter = 3

objExcelSheet.Range("A1") = "First Name"
objExcelSheet.Range("B1") = "Last Name"
objExcelSheet.Range("C1") = "Company"
objExcelSheet.Range("D1") = "Job Title"
objExcelSheet.Range("E1") = "Street"
objExcelSheet.Range("F1") = "City"
objExcelSheet.Range("G1") = "Province"
objExcelSheet.Range("H1") = "Postal Code"
objExcelSheet.Range("I1") = "Business Phone"
objExcelSheet.Range("J1") = "Fax Number"

objExcelSheet.Range("L1") = "Function"

objExcelApp.Application.Visible = True

For Each Item In objItems

'Set objControl = Item.GetInspector.ModifiedFormPages("Sales
Info").Controls("ListBox1")

Set objRange = objExcelSheet.Range("A" & objCounter)
objRange.Value = Item.FirstName
Set objRange = objExcelSheet.Range("B" & objCounter)
objRange.Value = Item.LastName
Set objRange = objExcelSheet.Range("C" & objCounter)
objRange.Value = Item.CompanyName
Set objRange = objExcelSheet.Range("D" & objCounter)
objRange.Value = Item.JobTitle
Set objRange = objExcelSheet.Range("E" & objCounter)
objRange.Value = Item.BusinessAddressStreet
Set objRange = objExcelSheet.Range("F" & objCounter)
objRange.Value = Item.BusinessAddressCity
Set objRange = objExcelSheet.Range("G" & objCounter)
objRange.Value = Item.BusinessAddressState
Set objRange = objExcelSheet.Range("H" & objCounter)
objRange.Value = Item.BusinessAddressPostalCode
Set objRange = objExcelSheet.Range("I" & objCounter)
objRange.Value = Item.BusinessTelephoneNumber
Set objRange = objExcelSheet.Range("J" & objCounter)
objRange.Value = Item.BusinessFaxNumber

' //This is listbox
' Set objRange = objExcelSheet.Range("L" & objCounter)
' If objControl.Selected(6) = True Then
' objRange.Value = objControl.List(6) //Looking for a
certain entry
' Else
' objRange.Value = "Other"
' End If

' //This is combobox

Set objRange = objExcelSheet.Range("L" & objCounter)
objRange.Value = Item.UserProperties("Function")

objCounter = objCounter + 1
Next

' Clean up variables

Set objExcelApp = Nothing
Set objExcelBook = Nothing
Set objExcelSheets = Nothing
Set objExcelSheet = Nothing
Set objExcelRange = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objContact = Nothing
Set objItems = Nothing
Set objRange = Nothing
Set objCounter = Nothing
Set objControl = Nothing

End Sub
 
S

Sue Mosher [MVP]

Outlook has known memory leak issues with large numbers of records. Using CDO would not only have less of a memory problem, but would also be an order of magnitude faster. See http://www.cdolive.com/cdo10.htm. You would also use Redemption's MAPITABLE object.
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top