Sort

M

MikeE

I want to sort my Outlook Contacts list so I can insert the address, name,
ect into a Word 2003 template using a list box. Presently I am sorting the
600 plus addresses as follows:

Private Sub UserForm_Activate()
Dim objOutlook As Outlook.Application
Dim fdrContacts As Outlook.MAPIFolder
Dim itmContacts As Outlook.ContactItem

Dim k As Integer
Dim j As Integer
Dim i As Integer
Dim aBuf As String


Set objOutlook = New Outlook.Application
Set fdrContacts = GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

For Each itmContacts In fdrContacts.Items

lstCompanyList.AddItem itmContacts.ItemProperties(52).Value _
& " " & itmContacts.ItemProperties(26)
Next
With lstCompanyList
k = .ListCount
For j = 0 To k - 1
For i = (j + 1) To (k - 1)
If .List(i) < .List(j) Then
aBuf = .List(j)
.List(j) = .List(i)
.List(i) = aBuf
End If
Next i
Next j
End With
End Sub

The problem is that it takes forever for the list box to be populated with
the names of the companies. When you open up the outlook contacts it opens
up immediatly and is sorted. How can I get a word VBA macro to open and sort
the list box as fast as the outlook contacts.

The other problem I have is that all of the names are sorted capitals first
then all the lower case names.

There has to be a better way. Any ideas?

Thanks Mike
 
J

Jay Freedman

I want to sort my Outlook Contacts list so I can insert the address, name,
ect into a Word 2003 template using a list box. Presently I am sorting the
600 plus addresses as follows:

Private Sub UserForm_Activate()
Dim objOutlook As Outlook.Application
Dim fdrContacts As Outlook.MAPIFolder
Dim itmContacts As Outlook.ContactItem

Dim k As Integer
Dim j As Integer
Dim i As Integer
Dim aBuf As String


Set objOutlook = New Outlook.Application
Set fdrContacts = GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

For Each itmContacts In fdrContacts.Items

lstCompanyList.AddItem itmContacts.ItemProperties(52).Value _
& " " & itmContacts.ItemProperties(26)
Next
With lstCompanyList
k = .ListCount
For j = 0 To k - 1
For i = (j + 1) To (k - 1)
If .List(i) < .List(j) Then
aBuf = .List(j)
.List(j) = .List(i)
.List(i) = aBuf
End If
Next i
Next j
End With
End Sub

The problem is that it takes forever for the list box to be populated with
the names of the companies. When you open up the outlook contacts it opens
up immediatly and is sorted. How can I get a word VBA macro to open and sort
the list box as fast as the outlook contacts.

The other problem I have is that all of the names are sorted capitals first
then all the lower case names.

There has to be a better way. Any ideas?

Thanks Mike

Hi Mike,

The slowness is due to three problems in your design. One is that you
chose a bubble sort, which is just about the slowest possible sorting
method for anything more than about 20 or 30 items. Another is that
you implemented the sort in VBA, rather than using the built-in sort
method that Microsoft implemented in machine language. The third is
that you're using the .List members of the list box for the sort
storage instead of using a string array variable.

Try this way instead:

Private Sub UserForm_Activate()
Dim objOutlook As Outlook.Application
Dim fdrContacts As Outlook.MAPIFolder
Dim itmContacts As Outlook.ContactItem

Dim i As Integer
Dim NameArray() As String
Dim Cnt As Long

Set objOutlook = New Outlook.Application
Set fdrContacts = _
GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

For Each itmContacts In fdrContacts.Items
ReDim Preserve NameArray(Cnt)
NameArray(Cnt) = itmContacts.ItemProperties(52).Value _
& " " & itmContacts.ItemProperties(26)
Cnt = Cnt + 1
Next
WordBasic.SortArray NameArray
For i = 0 To Cnt - 1
lstCompanyList.AddItem NameArray(i)
Next i
End Sub
 
J

Jay Freedman

Jay said:
Hi Mike,

The slowness is due to three problems in your design. One is that you
chose a bubble sort, which is just about the slowest possible sorting
method for anything more than about 20 or 30 items. Another is that
you implemented the sort in VBA, rather than using the built-in sort
method that Microsoft implemented in machine language. The third is
that you're using the .List members of the list box for the sort
storage instead of using a string array variable.

Try this way instead:

Private Sub UserForm_Activate()
Dim objOutlook As Outlook.Application
Dim fdrContacts As Outlook.MAPIFolder
Dim itmContacts As Outlook.ContactItem

Dim i As Integer
Dim NameArray() As String
Dim Cnt As Long

Set objOutlook = New Outlook.Application
Set fdrContacts = _
GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

For Each itmContacts In fdrContacts.Items
ReDim Preserve NameArray(Cnt)
NameArray(Cnt) = itmContacts.ItemProperties(52).Value _
& " " & itmContacts.ItemProperties(26)
Cnt = Cnt + 1
Next
WordBasic.SortArray NameArray
For i = 0 To Cnt - 1
lstCompanyList.AddItem NameArray(i)
Next i
End Sub

Here's one more possible speedup: Getting the company and person names by
passing indexes in the ItemProperties array is slightly slower than getting
the same values directly. Try replacing the lines

NameArray(Cnt) = itmContacts.ItemProperties(52).Value _
& " " & itmContacts.ItemProperties(26)

with these lines:

NameArray(Cnt) = itmContacts.CompanyName & _
" " & itmContacts.FullName

With over 600 contacts to retrieve, this may shave a second or two off the
total time. Besides, it's easier to understand when you look at the code.

When I run this code in the debugger, I notice that it now spends most of
its time transferring data from Outlook to Word. I'm not any sort of expert
on communication between Office applications, but I suspect there's a
quicker way to get the data. You should ask in the newsgroup
microsoft.public.outlook.interop.
 
M

MikeE

Thanks - the time required for the sort using your method was less than half
as long as my way.
 

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