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

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

"Office_Novice" wrote:

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

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


"Office_Novice" wrote:

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