Création, modification et suppression de contacts Outlook [Résolu]

[bulldozer27350]

Bonjour tout le monde, je cherche à modifier une liste de contacts : j'ai des contacts sur Outlook, et une base de données sur Access. Je souhaite ajouter les contacts dans Outlook, et dans le cas ou le contact existe déjà, je souhaite faire tout d'abord le supprimer et le remplacer pour au final, faire des modifications des champs non renseignés.
Je vous mes quand meme le code, au cas ou ça pourait déjà aiguiller sur ce que j'ai fait ...
P.S : je débute depuis avant hier le VB, donc soyez indulgents ...

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
105
106
107
108
109
110
111
112
113
114
115
116
117
 
Sub Transfert()
    Dim db As DAO.Database, rst As DAO.Recordset, fld As DAO.Field
    Dim rst2 As DAO.Recordset
    Dim sSQL As String
    Dim olApp As Object
    Dim olNs As Object
    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    olNs.Logon
    Dim newContact As Object
    Dim prenom As String
    Dim nom As String
    Dim mail As String
    Dim num As Integer
    Dim adresse1, adresse2, adresse3 As String
    Dim ville As String
    Dim postal As String
    Dim pays As String
    Dim i As Integer
    Dim test As String
    num = 0
    ' Ouverture de la base de données
    Set db = DBEngine.OpenDatabase("D:\BDL\BDL_PRG\Test.mdb")
    sSQL = "SELECT * FROM Contacts"
    ' Ouverture du recordset
    Set rst = db.OpenRecordset(sSQL, dbOpenForwardOnly, dbReadOnly)
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim olContact As Outlook.ContactItem ' Contact Outlook
    Dim olSearch As Outlook.Search ' Recherche Contact précédent
    Dim olResult As Outlook.Results ' Resultat de la recherche
    Dim j As Integer ' Compteur
    Dim cle As String
    Dim bool As Boolean
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    test = False
    Do While Not rst.EOF
        ' Initialisation des variables
        prenom = ""
        num = num + 1
        nom = ""
        mail = ""
        adresse = ""
        ville = ""
        postal = ""
        pays = ""
        ' Recherche le contact ayant la meme clé primaire (placé dans le telephonne personel)      
        Set olSearch = olApp.AdvancedSearch("'Contacts'", "urn:schemas:contacts:homePhone = '" & rst![Code] & "|" & rst![fonction] & "|" & rst![tel] & "|" & rst![origine] & "|" & rst![CODE_SOCIETE] & "'")
        ' Place le résultat dans olResult
        Set olResult = olSearch.Results
        If Not (olResult.Count = 0) Then
            olResult.Item(olResult.Count).Delete
            bool = True
        End If
        ' Destruction des objets qui ne seront plus utilisés
        Set olResult = Nothing
        Set olSearch = Nothing
        Set newContact = olApp.CreateItem(olContactItem)
        ' Mise en place de la clé primaire dans le champs du telephone personnel
 
newContact.HomeTelephoneNumber = rst![Code] & "|" & rst![fonction] & "|" & rst![tel] & "|" & rst![origine] & "|" & rst![CODE_SOCIETE]
 
' Test toutes les chaines pour savoir si elles sont renseignées ou non
        If Nz(rst![nom], "") <> "" Then
            newContact.FullName = rst![nom]
        End If
        If Not IsNull(rst![E_mail]) Then
            newContact.Email1Address = rst![E_mail]
        Else
            newContact.Email1Address = ""
        End If
        newContact.CustomerID = num
        If Nz(rst![tel], "") <> "" Then
            newContact.PrimaryTelephoneNumber = rst![tel]
        End If
        If Nz(rst![adresse1], "") <> "" Then
            adresse1 = rst![adresse1]
        Else
            adresse1 = ""
        End If
        If Nz(rst![adresse2], "") <> "" Then
            adresse2 = rst![adresse2]
        Else
            adresse2 = ""
        End If
        If Nz(rst![adresse3], "") <> "" Then
            adresse3 = rst![adresse3]
        Else
            adresse3 = ""
        End If
        newContact.MailingAddressStreet = adresse1 & adresse2 & adresse3
        If Nz(rst![ville], "") <> "" Then
            newContact.MailingAddressCity = rst![ville]
        End If
        If Nz(rst![Code_Postal], "") <> "" Then
            newContact.MailingAddressPostalCode = rst![Code_Postal]
        End If
        If Nz(rst![pays], "") <> "" Then
            newContact.MailingAddressState = rst![pays]
        End If
        If Nz(rst![fonction], "") <> "" Then
            newContact.JobTitle = rst![fonction]
        End If
        If Not Nz(rst![tel], "") <> "" Then
            newContact.PrimaryTelephoneNumber = rst![tel]
        End If
        newContact.Save
        rst.MoveNext
    Loop
    If (bool) Then
        MsgBox ("Les contacts ont étés insérés, mais il y a eu des doublons")
    Else
        MsgBox ("Les contacts ont étés insérés sans aucun problème")
    End If
    ' Fermeture du Recordset
    rst.Close
End Sub

et donc, il passe pas dans ma boucle qui est sencé supprimé un contact, or, je me retrouve avec des doublons tout à fait identiques !

[SpaceFrog]

juste pour faire avancer :

le problème se situe à mon avis ici:

Code :

1
2
3
4
5
6
7
8
9
' Recherche le contact ayant la meme clé primaire (placé dans le telephonne personel)
Set olSearch = olApp.AdvancedSearch("'Contacts'", "urn:schemas:contacts:homePhone = '" & rst![code] & "|" & rst![fonction] & "|" & rst![tel] & "|" & rst![origine] & "|" & rst![CODE_SOCIETE] & "'")
' Place le résultat dans olResult
Set olResult = olSearch.Results
If Not (olResult.Count = 0) Then
olResult.Item(olResult.Count).Delete  'ici ce n'est pas le bon contact qui est détruit
bool = True
End If

olResult est de quel type si c'est un tableau il faut boucler sur le tableau et en detruire les elements