Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olAL As Outlook.AddressList
Dim oFold As Outlook.Folders
Dim olAE As Outlook.AddressEntry
Dim objAddrEntriesColl As Object
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
For Each olAL In olNS.AddressLists
For Each olAE In olAL.AddressEntries
next
next