cant beat slow contacts problem

[Oggy]

Hi,

I have the following code that gets my contacts from outlook and
lists them in a listbox on a form to select one.


My problem is i have about 1000 contacts and it takes a while to
load,
then when i close the userform it then takes the same time to unload.


I understand the SETCOLUMN and RESETCOLUMN may resolve this problem,
but i dont seem to be able to make it work for me. I have taken it
back out of the code so not to confuse you. Its confussed me for days
now!

Many thanks in advance

Regards


Oggy


Private Sub UserForm_Initialize()
Dim olApp As Outlook.Application
Dim oContact As Outlook.ContactItem
Dim oContactFolder As Outlook.MAPIFolder
Dim oContactItems As Outlook.Items
Dim oNS As Outlook.Namespace
Dim i As Long
Dim j As Long
Dim arr()


With Me.ComboBox1
.ColumnCount = 3
.ColumnWidths = "175 pt;150 pt;200 pt"
.TextColumn = -1


End With


On Error GoTo XIT
Set olApp = New Outlook.Application
Set oNS = olApp.GetNamespace("MAPI")
Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
Set oContactItems = oContactFolder.Items


With Me
For i = 1 To oContactItems.Count
If oContactItems.Item(i).Class = olContact Then
Set oContact = oContactItems.Item(i)
If oContact.Categories = "Customer " Then
j = j + 1
ReDim Preserve arr(0 To 2, 1 To j)
With oContact
arr(0, j) = .CompanyName
arr(1, j) = .FullName
arr(2, j) = .BusinessAddress
End With
End If
End If
Next i


Me.ComboBox1.List() = Application.Transpose(arr)


End With


XIT:
Set oContact = Nothing
Set oContactItems = Nothing
Set oContactFolder = Nothing
Set oNS = Nothing
Set olApp = Nothing
End Sub

 

[Eric Legault [MVP - Outlook]]

As you probably already know, Outlook is notoriously slow when looping
through large collections. Too speed it up, I'd loop through an Items
collection obtained through a Restrict method for that folder using
"Customer" as the restriction on the Categories field.

Otherwise, Outlook 2007 has better support for processing large collections,
and you can always use Redemption's MAPITable (http://www.dimastr.com) to
give you MAPI-like speeds for loops.

 

[GS]

loading time can be reduced by avoiding the time consuming redim ...
preserve..
try add to the beginning of your code after the private sub
Dim jsz
jsz = 1200 ' should larger than the size you know, i pick 1200 because you
said 1000 contact
Dim Preserve arr(0 To 2, 1 To jsz)


replace your redim statement with checking if j >= jsz, if so increase jsz
by say 30% and redim with the new value of jsz