Ajouter des contacts

Ajouter des contacts dans Outlook

Sub AddOutlookContact()

    Dim Ol_App As New Outlook.Application
    Dim Ol_Mapi As NameSpace
    Dim Ol_Folder As MAPIFolder
    Dim Ol_Contact As Outlook.ContactItem

    Set Ol_Mapi = Ol_App.GetNamespace("MAPI")
    Set Ol_Folder = Ol_Mapi.GetDefaultFolder(olFolderContacts)
    Set Ol_Contact = Ol_App.CreateItem(olContactItem)

    With Ol_Contact

        .FirstName = "Asterix"
        .LastName = "ETPERIL"
        .FileAs = "LeGaulois"
        .Email1Address = "asterix@dolmen.fr"
        .Save

    End With

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

End Sub