Thanks Norman you have done it again!

One final thing, then i promise to leave you alone, When i pull in the
address i get the carriage return characters, how do i get rid of them?

Regards

Oggy


Norman Jones wrote:
Hi Oggy,

'---------------
I have alot of contacts split up by catogerys. Is there a way i can
pull in the outlook contacts by catogery so that i am not loading all
of my contacts.

'---------------

Try something like:

'=============
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.ListBox1
.ColumnCount = 3
.ColumnWidths = "90 pt;72 pt;90 pt"
.TextColumn = -1
.MultiSelect = fmMultiSelectSingle
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 = "Personal" Then '<<=== CHANGE
j = j + 1
ReDim Preserve arr(0 To 2, 1 To j)
With oContact
arr(0, j) = .FullName
arr(1, j) = .HomeAddress
arr(2, j) = .HomeTelephoneNumber
End With
End If
End If
Next i

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

End With

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


---
Regards,
Norman