utiliser carnet d'adresse outlook excel vba

bonjour

peux tu préciser ce que tu souhaites réaliser ?

Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library".
Dans l'éditeur de macros:
Menu Outils
Références

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub ExtraireContactsOutlook()
    'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
 
 
    Dim olApp As Outlook.Application
    Dim dossierContacts As Outlook.MAPIFolder
    Dim Contact As Outlook.ContactItem
    Dim i As Integer, j As Integer
 
    Set olApp = New Outlook.Application
    Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
 
    'Verifie si le dossier des contacts contient des éléments
    If dossierContacts.Items.Count = 0 Then Exit Sub
 
    'Création d'un entête dans la 1ere ligne
    j = 1
    For i = 0 To dossierContacts.Items(1).ItemProperties.Count - 1
        Cells(j, i + 1) = dossierContacts.Items(1).ItemProperties.Item(i).Name
    Next i
 
    On Error Resume Next
 
    'Boucle sur les éléments pour récupérer les infos
    For Each Contact In dossierContacts.Items
        j = j + 1
        For i = 0 To Contact.ItemProperties.Count - 1
            Cells(j, i + 1) = Contact.ItemProperties.Item(i).Value
        Next i
    Next Contact
 
    Columns.AutoFit
    MsgBox "Opération terminée."
End Sub

Pour récupérer quelques informations spécifiques, utilise la procédure suivante.
(Exemple: extraire les numéros de téléphone)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub numeroTelephone_contactsOutlook()
    Dim olApp As Outlook.Application
    Dim Cible As Outlook.ContactItem
    Dim dossierContacts As Outlook.MAPIFolder
 
    Set olApp = New Outlook.Application
    Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
 
    For Each Cible In dossierContacts.Items
        Debug.Print Cible.HomeTelephoneNumber & vbTab & Cible.LastNameAndFirstName
    Next
End Sub

michel