Option Explicit
Dim out As Outlook.Application
Dim Cible As Outlook.ContactItem
Dim dossierContacts As Outlook.MAPIFolder
Dim liste
Sub contactsOutlook()
Set out = New Outlook.Application
Set dossierContacts = out.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Set liste = CreateObject("Scripting.Dictionary")
For Each Cible In dossierContacts.Items
If Not liste.Exists(Cible.Email1Address) Then liste.Add Cible.Email1Address, Cible.Email1Address
Next Cible
Sheets(1).Range("A1", Cells(liste.Count, "A")) = Application.Transpose(liste.Keys)
Columns("A").AutoFit
Set liste = Nothing
End Sub