Importer et Exporter contact <=> Excel

[yusukens]

Bonjour,
Après de longue recherche sur internet.

je viens vers vous pour m'aider a adapter un code VB

j'ai trouvé ce CODE dans le forum :

Sub ExtraireContactsOutlook()
 [COLOR=seagreen] 'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"[/COLOR]
    
    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)
    
    [COLOR=seagreen]'Verifie si le dossier des contacts contient des éléments[/COLOR]
    If dossierContacts.Items.Count = 0 Then Exit Sub
    
    [COLOR=seagreen]'Création d'un entête dans la 1ere ligne[/COLOR]
    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
    
    [COLOR=seagreen]'Boucle sur les éléments pour récupérer les infos[/COLOR]
    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

LE code permet d'importer les contacts de outlook vers excel.

serai t'il possible de l'adapter afin qu'il prenne seulement 15 champs plutôt que l'ensemble des champs du contact (pour un gain de chargement)

et sinon, ça j'ai beau cherché je ne trouve pas de réponse,
pouvoir faire le contraire, c'est a dire de partir de excel pour aller vers outlook.

jusqu'a la je faisai des import Export mais j'aimerai le mettre en VBA si c'est possible.

Toute remarque sera le bien venu.

 

[Roland_M]

Re : Importer et Exporter contact <=> Excel

Bien le bonjour à tous.
Rajoute ce qui est en rem '<<<<< rajouter<<<<<<
Roland.

'ton Sub---------------------
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
If I >= 15 Then Exit For '<<<<<< rajouter <<<<<<<<<<<<<<<<
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
If J >= 15 Then Exit For '<<<<<< rajouter <<<<<<<<<<<<<<<<
Next Contact

Columns.AutoFit
MsgBox "Opération terminée."
End Sub

 

[yusukens]

Re : Importer et Exporter contact <=> Excel

Salut Roland_M
j'ai essayé ton code,
mais ça change rien, la macro continu a extraire les contacts pour l'insérer dans le tableau excel.

je m'y prend peut etre mal.
j'ai fais un copie collé de ton code vers un module VBA
En changean
Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFold erContacts)
par
Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

et

Cells(J, I + 1) = dossierContacts.Items(1).ItemProperties.Item(I).Na me
par
Cells(J, I + 1) = dossierContacts.Items(1).ItemProperties.Item(I).Name


car ça me faisait des erreurs.
j'ai ensuite lancé la macro ExtraireContactsOutlook