MS Excel

Použíjete následující odkazy i zkombinujte správný kod

http://www.mrexcel.com/forum/showthread.php?t=46961

http://www.techrepublic.com/blog/msoffice/quickly-export-outlook-e-mail-items-to-excel/744

http://www.eggheadcafe.com/tutorials/excel/edd4a3d0-7a24-47e8-98c2-e26898a2b7bb/getting-data-from-outlook-address-lists-into-excel.aspx

Přibližný kod
Private Sub GetOutlookAddressBook()

' Need to add reference to Outlook
'(In VBA editor Tools References MS Outlook #.# Library)
' Adds addresses to existing Sheet called Address and
' defines name Addresses containing this list
' For use with data Validation ListBox (Source as =Addresses)

On Error GoTo error

Dim objOutlook As Outlook.Application
Dim objAddressList As Outlook.AddressList
Dim objAddressEntry As Outlook.AddressEntry
Dim intCounter As Integer

' Setup connection to Outlook application
Set objOutlook = CreateObject("Outlook.Application")
Set objAddressList = objOutlook.Session.AddressLists("Contacts")

Application.EnableEvents = False

' Clear existing list
Sheets("Address").Range("A:A").Clear

'Step through each contact and list each that has an email address
For Each objAddressEntry In objAddressList.AddressEntries
If objAddressEntry.Address <> "" Then
intCounter = intCounter + 1
Application.StatusBar = "Address no. " & intCounter & " ... " & objAddressEntry.Address
Sheets("Address").Cells(intCounter, 1) = objAddressEntry.Address
DoEvents
End If
Next objAddressEntry

' Define range called "Addresses" to the list of emails
Sheets("Address").Cells(1, 1).Resize(intCounter, 1).Name = "Addresses"
error:
Set objOutlook = Nothing
Application.StatusBar = False
Application.EnableEvents = False
End Sub

Vylepšite ho k vložení než celý adresář a oddělený kontakt.citovat