Lire les contacts

Lire les contacts d'Outlook

Sub ListOutlookContacts()
    On Error Resume Next
    Dim StrContacts As String
    Dim Ol_App As New Outlook.Application
    Dim Ol_Mapi As Outlook.NameSpace
    Dim Ol_Folder As Outlook.MAPIFolder
    Dim Ol_Items As Outlook.Items
    Dim Ol_Contact As Outlook.ContactItem

    Set Ol_Mapi = Ol_App.GetNamespace("MAPI")
    Set Ol_Folder = Ol_Mapi.GetDefaultFolder(olFolderContacts)
    Set Ol_Items = Ol_Folder.Items

    For Each Ol_Contact In Ol_Items
        StrContacts = StrContacts & vbCrLf & _
                      Ol_Contact.FullName & _
                      " - " & Ol_Contact.Email1Address
    Next Ol_Contact

    MsgBox StrContacts

    Set Ol_Contact = Nothing
    Set Ol_Items = Nothing
    Set Ol_Folder = Nothing
    Set Ol_Mapi = Nothing
    Set Ol_App = Nothing

End Sub