Importing Outlook Items into Spread Sheet Eats RAM!

[Tony]

I am trying to do a simple import of items that are in an outlook
public folder to an excel spreadsheet.

This seems to work well but contains some major memory issues. I have
over 1000 OL items that I need to import to my spreadsheet but it
seems to hang up around 150 and I get all kinds of memory errors,
mainly in outlook.

Does anyone know of an easier way to do this or any suggestions on
where my code is having my ram for lunch.

I have watched this code run with the task manager up and it is eating
approx. 1Meg for every 2 OLitem.

Please help.

Tony


'THIS IS THE VBA CODE THAT I AM USING IN EXCEL.

Option Explicit

Dim myOlApp
Dim MyNameSpace As NameSpace
Dim PublicFolders As MAPIFolder
Dim AllPublicFolders As MAPIFolder
Dim dFolders As MAPIFolder
Dim XRef As MAPIFolder
Dim Items As Outlook.Items
Dim XRefItem As Object


Private Sub CommandButton1_Click()

Set myOlApp = CreateObject("Outlook.Application")
Set MyNameSpace = myOlApp.GetNamespace("MAPI")
Set PublicFolders = MyNameSpace.Folders("Public Folders")
Set AllPublicFolders = PublicFolders.Folders("All Public Folders")
Set dFolders = AllPublicFolders.Folders("Department")
Set XRef = dFolders.Folders("XRef")
Set Items = XRef.Items

'Set up Header Row and Column Widths
Range("A1:N1").Value = Array("SampleNum", "Date", "Customer",
"CustDesc", "Description", "StockNum", "PartNum", "Width", "Warp",
"Fill", "Price", "10DigitCode", "SpecialCmts", "EntryID")

Range("A1,B1,G1,H1,I1,J1,K1,L1").HorizontalAlignment = xlCenter
Range("A1,B1,G1,H1,I1,J1,K1,L1").Font.Bold = True

Range("C1,D1,E1,F1,M1,N1").HorizontalAlignment = xlLeft
Range("C1,D1,E1,F1,M1,N1").Font.Bold = True

Range("I:J").Select
Selection.ColumnWidth = 5

Range("A:B,G:H,K:L").Select
Selection.ColumnWidth = 10

Range("C,F:F").Select
Selection.ColumnWidth = 20

Range("E:E,M:M").Select
Selection.ColumnWidth = 40

Range("N:N").Select
Selection.ColumnWidth = 30
'Selection.EntireColumn.Hidden = True

'Return here to get ready for data import
Range("A1").Select

'Import data from Outlook

Dim x As Integer
x = 1

'Loop through each field in each record
For Each XRefItem In Items

ActiveCell.Offset(x) =
XRefPage.GetInspector.ModifiedFormPages("Cross
Reference").Controls("SampleNum")
ActiveCell.Offset(x, 1) =
XRefPage.GetInspector.ModifiedFormPages("Cross
Reference").Controls("Date")
ActiveCell.Offset(x, 2) =
XRefPage.GetInspector.ModifiedFormPages("Cross
Reference").Controls("Customer")
ActiveCell.Offset(x, 3) =
XRefPage.GetInspector.ModifiedFormPages("Cross
Reference").Controls("CustDescription")
ActiveCell.Offset(x, 4) =
XRefItem.GetInspector.ModifiedFormPages("Cross
Reference").Controls("Description")
ActiveCell.Offset(x, 5) =
XRefItem.GetInspector.ModifiedFormPages("Cross
Reference").Controls("StockNum")
ActiveCell.Offset(x, 6) =
XRefItem.GetInspector.ModifiedFormPages("Cross
Reference").Controls("PartNum")
ActiveCell.Offset(x, 7) =
XRefItem.GetInspector.ModifiedFormPages("Cross
Reference").Controls("Width")
ActiveCell.Offset(x, 8) =
XRefItem.GetInspector.ModifiedFormPages("Cross
Reference").Controls("Warp")
ActiveCell.Offset(x, 9) =
XRefItem.GetInspector.ModifiedFormPages("Cross
Reference").Controls("Fill")
ActiveCell.Offset(x, 10) =
XRefItem.GetInspector.ModifiedFormPages("Cross
Reference").Controls("Price")
ActiveCell.Offset(x, 11) =
XRefItem.GetInspector.ModifiedFormPages("Cross
Reference").Controls("10DigitCode")
ActiveCell.Offset(x, 12) =
XRefItem.GetInspector.ModifiedFormPages("Cross
Reference").Controls("SpecialCmts")
ActiveCell.Offset(x, 13) = XRefItem.EntryID
x = x + 1

Next

Set XRefItem = Nothing
Set Items = Nothing
Set XRef = Nothing
Set dFolders = Nothing
Set AllPublicFolders = Nothing
Set PublicFolders = Nothing
Set MyNameSpace = Nothing
Set myOlApp = Nothing

End Sub

Private Sub CommandButton2_Click()

Me.Hide

End Sub

 

[Dick Kusleika]

Tony

I don't have an answer for you, but I'll give you something to try. First,
I don't know what ModifiedFormPages are, but I'll assume they're some sort
of customization and the info on there is not accessible from the
UserProperties property of the Item object.

I would guess that all the calls to GetInspector is what's eating the ram.
I wonder if something like this would work

With XRefPage.GetInspector.ModifiedFormPages("Cross Reference")
ActiveCell.offset(x) = .Controls("SampleNum")
ActiveCell.Offset(x,1) = .Controls("Date")
'etc...
End With

Maybe only one GetInspector call will reduce the consumption. If not, then
I'm way off.

 

[keepITcool]

you;re definetely not using a standard approach
i assume you want to retrieve the info of userdefined fields.

try the XrefItem.UserProperties.find("SampleNum") method of the xRefItem
object instead of using the GetInspector.controls().Value method.

and would be lot's faster!

you;re method is even slower that if you'd ask excel to select
each cell and then retrieve the activecell's value, since the getinspector
method involves a lot of screenhandling too!


are all items in the folder of the same olitemtype?
(mailItem / etc..



names of the userproperties may not be exactly the same as the controls...
to be sure of the names..

For a first time scan..
dim xUPS as outlook.userpropeties
dim xUP as outlook.userproperty
dim i as integer

set xUPS = xrefitem.userproperties

For i=1 to xUPS.count
set xUP = xUps(i)
debug.print i;xUp.name;xUp '.Value is default property
Next

Note that although the userproperties is a collection you can only use a
numerical index!. You'll have to use the FIND method for a string index.

Hope this is it..
Suc6



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >