Manipulation du carnet d'adresse outlook via VBA Excel?

Version imprimable

Bonjour,

Je voudrais pouvoir ajouter un contact à mon carnet d'adresse via outlook, voici le code que j'ai essayer de mettre en place:
Sub Create_Contacts()
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Dim myOlApp As New Outlook.Application ' variable application outlook Dim myOlNameSpace As NameSpace Dim myFolder As Variant '???? Dim myWorkFolder As Variant '???Folders Dim myNewContact As ContactItem Set myOlApp = CreateObject("Outlook.Application") Set myOlNameSpace = myOlApp.GetNamespace("MAPI") Set myWorkFolder = myOlNameSpace.PickFolder Set myNewContact = myOlApp.CreateItem(olContactItem) myNewContact.Display 'Do ' If Not myNewContact.Saved Then ' myNewContact.Move myWorkFolder ' Exit Do ' End If 'Loop End Sub
Le problème, c'est que le contact est placé dans le contact par défaut de outlook et pas dans le répertoire contenu dans la variable "myWorkFolder"

J'ai essayé en ajoutant le code mis en commentaire mais alors dans se cas, le contact est sauvegardé sans attendre que je pousse sur le bouton "save and close".
D'ailleurs comment puis-je faire pour récupérer l'info comme quoi j'ai cliquer sur "sanve and close"?

Dans une autre recherche, j'aurais aimer pouvoir mettre tout les noms de mes contacts dans une comboBox pour les sélectionné et placer dans une feuille. Et se en n'étant pas dans le répertoire par défaut (ex: rép contacts/clients).

J'ai déjà fait des recherches dans le forum, les tutoriels, google mais je ne trouve pas de réponse. Peux-être suis-je trop débutant... :(

Merci d'avance de votre aide

Vincent

04/11/2005, 21h14
AlainTech

Bonjour et bienvenue sur ce forum.

Je vois que personne ne t'a encore répondu...
Malheureusement, je ne pourrai pas t'aider, n'ayant pas d'expérience en programmation d'Outlook.

Je sais que certains, ici, ont déjà joué avec ça.

Je pense qu'un spécialiste ne tardera pas à passer par là.

Bonne chance.

Bonjour,

J'ai un peu avancé sur mon problème.
Voici un code qui fonctionne, je me suis dis que cela intéressera peut-être l'un ou l'autre.

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
 
Sub Create_Contacts()
 
    Dim myOlApp As New Outlook.Application ' variable application outlook
    Dim myOlNameSpace As Namespace
    Dim myWorkFolder As Variant '???Folders
    Dim myNewContact As ContactItem
 
    Dim tabMyWorkFolder(1) As String '2 répertoires disponible
    Dim intIndexMaxTabFolder As Integer
    Dim intIndexTabFolder As Integer
    Dim strTestChamps As String
    Dim intTestPhone As Integer
 
    'Initialisation des noms de folders disponibles
    tabMyWorkFolder(0) = "Clients"
    tabMyWorkFolder(1) = "Fourniss & Contacts Pro's"
    intIndexMaxTabFolder = 1
 
    'initialisation de l'object outlook
    Set myOlApp = CreateObject("Outlook.Application")
    Set myOlNameSpace = myOlApp.GetNamespace("MAPI")
    Set myNewContact = myOlApp.CreateItem(olContactItem)
 
    ' choix du répertoire d'enregistrement du contact
    'Boucle jusqu'à ce que le bon répertoire soit selectionné
    Do
        Set myWorkFolder = myOlNameSpace.PickFolder
        ' si myWorkFolder = cancel
        If myWorkFolder Is Nothing Then
            Exit Sub
        Else
            For intIndexTabFolder = 0 To intIndexMaxTabFolder
                If myWorkFolder = tabMyWorkFolder(intIndexTabFolder) Then
                    Exit Do
                End If
            Next intIndexTabFolder
        End If
 
    Loop
 
    ' enregistrement du contact
 
    ' encodage des champs automatiques
    With myNewContact
        Select Case myWorkFolder
            Case tabMyWorkFolder(0) 'clients
                .HomeAddressCountry = "Belgium"
                .SelectedMailingAddress = olHome
                .Categories = "Clients"
            Case tabMyWorkFolder(1) 'fournisseur
                .BusinessAddressCountry = "Belgium"
                .SelectedMailingAddress = olBusiness
        End Select
 
 
        Do 'test les numéros de tél et mail si nécessaire
 
            Do 'test des champs obligatoires pour les adresses
                .Display (vbModal)
 
                strTestChamps = ""
                Select Case myWorkFolder
                    Case tabMyWorkFolder(0) 'clients
                        If .Title = "" Then
                            strTestChamps = strTestChamps & "Le titre, "
                        End If
                        'if ...
			'end if	
                    Case tabMyWorkFolder(1) 'fournisseur
                        .FileAs = .CompanyAndFullName
                        If .CompanyName = "" Then
                            strTestChamps = strTestChamps & "Société?, "
                        End If
                        'if ...
			'end if	
 
                End Select
 
                ' test si un champs est manquant pour affichage du message
                If strTestChamps <> "" Then
                    strTestChamps = Left(strTestChamps, Len(strTestChamps) - 2) & " sont à compléter"
                    MsgBox strTestChamps
                End If
 
            Loop Until strTestChamps = ""
 
 
            intTestPhone = 6
            If .Business2TelephoneNumber = "" And .BusinessTelephoneNumber = "" And .BusinessFaxNumber = "" _
            And .Home2TelephoneNumber = "" And .HomeTelephoneNumber = "" And .HomeFaxNumber = "" _
            And .Email1Address = "" And .Email2Address = "" And .Email3Address = "" Then
                intTestPhone = MsgBox("Voulez-vous continuer sans introduire de tél. ou de mail?", vbYesNo, "Communication")
            End If
 
        Loop Until intTestPhone = 6 '6 = yes // 7 = No
 
    End With
 
    'l'enregistrement du contact se fait automatiquement dans le répertoire par défaut d'outlook
    ' ==> il faut le déplacer dans le répertoire voulu
    myNewContact.Move myWorkFolder
 
End Sub

La dernière commande vaut ce qu'elle vaut mais je n'ai pas trouver d'autre moyen pour enregistrer le contact dans le répertoire voulu.

Si vous connaissez le champs que je dois remplir pour ne plus devoir passer par le

Code:

1
2
 
 myNewContact.Move myWorkFolder

Cela m'intéresse

Il ne me reste plus qu'a trouver le moyen de récupérer contact dans un de mes répertoires contacts et d'insérer les éléments dans la feuille excel. Si vous avez des pistes ... en attendant je planche dessus.

Bon WE,

Vincent