Code provided by my AllEmailCode product, which can
be used from Visual Basic, Access/VBA, Word/VBA, and
Excel/VBA.
Sub HowToListAllAddressBookEntries()
On Error GoTo ErrorHandling_Err
' ------------------------------------------------------------------
' Purpose: Example of how to query all address entries from Outlook
'
' Accepts: Nothing
'
' Returns: Nothing
'
' NOTE: Reminder to reference the MS Outlook 9.0 Object Library
' prior to calling this procedure.
' ------------------------------------------------------------------
Const STARTING_ADDRESS = 1
Dim oOutLookApplication As Object
Dim onMAPI As NameSpace
Dim oaeAddresses As AddressEntries
Dim oaeAddress As AddressEntry
Dim iCounter As Integer
iCounter = STARTING_ADDRESS
Set oOutLookApplication = CreateObject("Outlook.Application")
Set onMAPI = oOutLookApplication.GetNamespace("MAPI")
Set oaeAddresses = onMAPI.AddressLists.Item(1).AddressEntries
Set oaeAddress = oaeAddresses.GetFirst
'Loop through the addresses and print the name and related email address
Do Until oaeAddress Is Nothing
Debug.Print oaeAddresses.Item(iCounter).Name & " (" & oaeAddresses.Item(iCounter).Address & ")"
iCounter = iCounter + 1
Loop
ErrorHandling_Err:
If Err Then
'Trap your error(s) here, if any!
End If
End Sub