OLE Question

[Office_Novice]

Greetings, I would like to use OLE to extact my address book from outlook.
What i have will get the names but i want all the info contained in the
address book any thoughts? Here is what i have found so far

Option Explicit
Public Sub DisplayOutlookContactNames()
Dim Outlook As Outlook.Application
Dim NameSpace As Outlook.NameSpace
Dim AddressList As AddressList
Dim Entry As AddressEntry
Dim i As Long

On Error GoTo Finally
Set Outlook = New Outlook.Application
Set NameSpace = Outlook.GetNamespace("MAPI")
Set AddressList = NameSpace.AddressLists("Contacts")
For Each Entry In AddressList.AddressEntries
i = i + 1
Cells(i, 1).Value = Entry.Name

Next

Finally:
'Outlook.Quit
Set Outlook = Nothing
End Sub

 

[Ralph]

Use GetContact with the address entry.

Cells(i, 1).Value = Entry.Name
Cells(i, 2).Value = Entry.GetContact.Email1Address
Cells(i, 3).Value = Entry.GetContact.Birthday
Cells(i, 4).Value = Entry.GetContact.BusinessAddress

 

[Ralph]

My previous post uses Outlook 2007 below should work for 2003

Public Sub DisplayOutlookContactNames()
Dim olApp As Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olContacts As Outlook.Items
Dim olItem As Outlook.ContactItem
Dim i As Long

Set olApp = New Outlook.Application
Set olNs = Outlook.GetNamespace("MAPI")
Set olContacts = olNs.GetDefaultFolder(olFolderContacts).Items
Set olItem = olContacts.GetFirst
Do While Not olItem Is Nothing
i = i + 1
Cells(i, 1).Value = olItem.LastName
Cells(i, 2).Value = olItem.Email1Address
Set olItem = olContacts.GetNext
Loop

End Sub