synchro outlook-access : prob avec les modifs de fiches

**sebinator** · 09/06/2008, 17h02

Bonjour,

Avec le code ci dessous, je peux synchroniser les contacts outlook2k3 avec un bdd access 2k3 :

Code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
 
 
'Dans un module : 
 
Public Sub ParcourirContact()
 
'*************************************************************************
 
' Routine qui va parcourir les enregistrements présents dans le répertoire
 
' contacts et copier les enregistrements manquants dans la base de données
 
' Macro crée pour article DVP par Olivier Lebeau
 
'*************************************************************************
 
Dim oCont As ContactItem
Dim oFold As MAPIFolder
Dim nM As NameSpace
Dim olApp As Outlook.Application
Dim i As Integer
Dim j As Integer
 
j = 1
 
' Affectation des objets
 
Set olApp = CreateObject("Outlook.Application")
Set nM = olApp.GetNamespace("MAPI")
Set oFold = nM.GetDefaultFolder(olFolderContacts)
 
 
 
i = oFold.Items.Count
 
' Boucle pour parcourir les contacts locaux
 
For j = 1 To i
 
    ' Appel à la fonction AccesADB avec comme paramètre le contactItem
 
    AccesADB (oFold.Items(j))
 
Next j
 
End Sub
 
 
 
Public Function AccesADB(mycont As ContactItem)
 
'**************************************************************************
 
' Fonction appelée pour envoyer vers la base de données les nouveaux
 
' contacts
 
' Fonction écrite pour article DVP par Olivier Lebeau
 
'**************************************************************************
 
On Error Resume Next
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sql As String
 
sql = "SELECT Contacts.*, Contacts.[Nom], Contacts.[Prénom]"
sql = sql & " FROM Contacts "
sql = sql & " Where Contacts.[Nom] = """ & mycont.LastName
sql = sql & """ AND Contacts.[Prénom] = """ & mycont.FirstName & """;"
 
' Debug.Print sql
' Vous devez spécifier le chemin complet de votre base de données
 
Set db = OpenDatabase("C:\tempAcc\contacts.mdb")
Set rs = db.OpenRecordset(sql)
 
' Debug.Print rs.RecordCount
 
'**********************************************************************
 
' La liste des champs traités peut être augmentée en fonction de vos
 
' besoins. Par facilité, je n'ai volontairement mis que 3 champs
 
' Si vous rencontrez des problèmes avec les lignes Fields("xxxxx")
 
' je vous conseille d'utiliser l'index du champ Fields(2)
 
'**********************************************************************
 
 
 
If rs.RecordCount = 0 Then
 
    rs.AddNew
    rs.Fields(2) = Nz(mycont.LastName, " ")
    rs.Fields(3) = Nz(mycont.FirstName, " ")
    rs.Fields(4) = mycont.Email1Address
    rs.Fields(1) = Nz(mycont.CompanyName, " ")
    rs.Update
 
End If
 
'**********************************************************************
 
' Libération des objets
 
'**********************************************************************
 
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function
 
Public Sub MettreAJourContact()
 
'******************************************************************************
 
' Procédure pour récupérer les enregistrements présents dans la base de
 
' données et les injecter dans le répertoire contact.
 
'******************************************************************************
 
On Error Resume Next
 
Dim oCont As ContactItem
Dim oCo As ContactItem
Dim oFold As MAPIFolder
Dim nM As NameSpace
Dim olApp As Outlook.Application
Dim stFilt As String
Dim rs As DAO.Recordset
Dim db As DAO.Database
 
'******************************************************************************
 
' Affectation des objets
 
'******************************************************************************
 
Set db = OpenDatabase("C:\tempAcc\contacts.mdb")
Set rs = db.OpenRecordset("Select * From Contacts")
Set olApp = CreateObject("Outlook.Application")
Set nM = olApp.GetNamespace("MAPI")
Set oFold = nM.GetDefaultFolder(olFolderContacts)
 
'******************************************************************************
 
' Boucle pour parcourir les enregistrements de la table
 
'******************************************************************************
While Not rs.EOF
 
'Filtre pour recherche des données déjà existantes dans les contacts locaux
 
stFilt = "[FirstName] = """ & rs.Fields(3)
stFilt = stFilt & """ And [LastName] = """ & rs.Fields(2) & """"
 
' Recherche avec filtre
 
Set oCo = oFold.Items.Find(stFilt)
 
' procédure décisionnelle pour copie des données
 
If oCo = "Nothing" Then
 
    ' Si pas de données, on les ajoute
 
    Set oCont = oFold.Items.Add
        oCont.FirstName = rs.Fields(3)
        oCont.LastName = rs.Fields(2)
        oCont.Email1Address = rs.Fields(4)
        oCont.CompanyName = rs.Fields(1)
        oCont.Save
 
End If
 
' Déplacement vers l'enregistrement suivant.
 
rs.MoveNext
 
Wend
 
' Libération des objets
 
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
 
End Sub
 
 
'A placer dans outlookthissession
 
Private Sub Application_Startup()
 
Dim strFichier As String
 
    strFichier = "C:\tempAcc\contacts.mdb"
    If Dir(strFichier) <> "" And strFichier <> "" Then
        MettreAJourContact
        ParcourirContact
 
        MsgBox "Base de données Access synchronisée !"
 
    Else
 
        MsgBox "La Base de n'est pas accessible ! Vérifiez la connexion réseau ! La synchronisation ne peut se faire !", vbInformation
 
    End If
 
End Sub
 
 
Private Sub Application_Quit()
Dim strFichier As String
 
    strFichier = "C:\tempAcc\contacts.mdb"
    If Dir(strFichier) <> "" And strFichier <> "" Then
        MettreAJourContact
        ParcourirContact
        MsgBox "Base de données Access synchronisée !"
 
    Else
 
 
    End If
End Sub

Mon problème maintenant sont les modifications :

Par ex: si une adresse mail est modifiée sur une fiche dans outlook, celle ci n'est pas synchronisée dans la bdd. C'est embettant.

Comment peut-on détecter la modif et initié la maj de la bdd ?

Merci d'avance

Seb

**Oliv-** · 09/06/2008, 18h03

SAlut,

En comparant une date de synchro (à stocker) avec la date de modif des contacts. Il faut peut être aussi stocker un identifiant unique désignant ton contact si tu changes son nom

**sebinator** · 10/06/2008, 09h29

l'identifiant unique je l'ai... c'est la clef primaire dans la bdd.

mais comment faire pour récupérer la date de modif d'une fiche dans outlook ?

**Oliv-** · 10/06/2008, 11h02

Salut,
c'est la propriété

LastModificationTime
ex: #16/11/2007 12:46:23#

**sebinator** · 12/06/2008, 13h08

Ok,

dans ma bdd, j'ai ajouté un champ datesync que j'alimente avec la proprièté que tu m'as donné, j'ai aussi ajouté un champ modifbdd qui récupère la date de modif si la fiche est modifiée dans access.

je coince dans le code, en fait je suis largué.

A quel niveau dans le code je dois intervenir pour lui dire :

lors de la synchro, de comparer les dates de modifs des fiches outlook et les dates de modifs contenues dans champs datesync et modifbdd et de synchroniser la fiche la plus récente....

**Oliv-** · 13/06/2008, 09h16

Salut,
A chaque boucle (changement de contact ou ligne) il faut faire ce controle.
A toi a définir la priorité aussi fichier prévaut sur outlook ou le contraire.
Bon courage

**sebinator** · 19/06/2008, 14h08

Bien, j'avance doucement...

j'ai ajouté le code ci dessous dans la function accesADB.

A partir d'outlook, quand je modifie une adresse email sur une fiche existante et déja dans la BDD. La modif est bien détectée et la synchro se fait... Yesssss.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Dim LastDateModif As String
'////////////////////////////////////////////////////////////////////////////////
'alimente la variable LastDateModif avec la date de modif de la fiche
'////////////////////////////////////////////////////////////////////////////////
LastDateModif = mycont.LastModificationTime
 
'////////////////////////////////////////////////////////////////////////////////
'compare la date de modif de la fiche avec la date de modif présente dans la Bdd
'Si la fiche est plus récente, l'enregistrement est mis a jour dans la Bdd
'////////////////////////////////////////////////////////////////////////////////
If LastDateModif > rs.Fields(18) Then
    rs.Edit
    rs.Fields(2) = Nz(mycont.LastName, " ")
    rs.Fields(3) = Nz(mycont.FirstName, " ")
    rs.Fields(4) = mycont.Email1Address
    rs.Fields(1) = Nz(mycont.CompanyName, " ")
    rs.Fields(18) = mycont.LastModificationTime
    rs.Update
End If

Maintenant je cherche à faire le contraire, a savoir que si la fiche est plus récente dans la bdd, la synchro doit mettre a jour la fiche dans outlook. je pars donc sur le même principe mais je ne trouve pas la propriété pour mettre a jour la fiche... je vois bien items.add,delete... mais pas de modify ou edit...

**Oliv-** · 19/06/2008, 17h12

Salut,
Il me semble que lorsque tu vas faire ta mise à jour de outlook, avec la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

oCont.Save

le champs

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

mycont.LastModificationTime

va être automatiquement modifié.
et donc il faut faire un update de access avec cette date.

**sebinator** · 19/06/2008, 17h40

J'essaye avec save et ca ne fonctionne pas.

voila ce que j'ai mis :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'////////////////////////////////////////////////////////////////////////////////
'compare la date de modif de la fiche avec la date de modif présente dans la Bdd
'Si la fiche de la bdd est plus récente, l'enregistrement est mis a jour dans outlook
'////////////////////////////////////////////////////////////////////////////////
 
LastDateModif = oCont.LastModificationTime
 
If rs.Fields(18) > LastDateModif Then
 
        oCont.CompanyName = rs.Fields(1)
        oCont.LastName = rs.Fields(2)
        oCont.FirstName = rs.Fields(3)
        oCont.Email1Address = rs.Fields(4)
        oCont.Save
 
End If

Si je modifie une fiche en changeant une adresse mail et mettant un date de modif plus recente que celle dans outlook, rien ne passe... je ne dois pas m'y prendre correctement

**Oliv-** · 19/06/2008, 18h19

Peux tu publier ton code complet je vais tester sur mon poste

**sebinator** · 20/06/2008, 07h39

voici le code

Dans un module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
Public Function AccesADB(mycont As ContactItem)
 
'**************************************************************************
 
' Fonction appelée pour envoyer vers la base de données les nouveaux
' contacts
' Fonction écrite pour article DVP par Olivier Lebeau
 
'**************************************************************************
' Modif
'
'
'*************************************************************************
On Error Resume Next
 
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sql As String
Dim LastDateModif As String
 
sql = "SELECT Contacts.*, Contacts.[Nom], Contacts.[Prénom]"
sql = sql & " FROM Contacts "
sql = sql & " Where Contacts.[Nom] = """ & mycont.LastName
sql = sql & """ AND Contacts.[Prénom] = """ & mycont.FirstName & """;"
 
' Debug.Print sql
' Vous devez spécifier le chemin complet de votre base de données
 
Set db = OpenDatabase("C:\tempAcc\contacts.mdb")
Set rs = db.OpenRecordset(sql)
 
 
'**********************************************************************
' La liste des champs traités peut être augmentée en fonction de vos
' besoins. Par facilité, je n'ai volontairement mis que 3 champs
' Si vous rencontrez des problèmes avec les lignes Fields("xxxxx")
' je vous conseille d'utiliser l'index du champ Fields(2)
'**********************************************************************
 
If rs.RecordCount = 0 Then
 
    rs.AddNew
    rs.Fields(2) = Nz(mycont.LastName, " ")
    rs.Fields(3) = Nz(mycont.FirstName, " ")
    rs.Fields(4) = mycont.Email1Address
    rs.Fields(1) = Nz(mycont.CompanyName, " ")
    rs.Fields(18) = mycont.LastModificationTime
    rs.Update
 
End If
'////////////////////////////////////////////////////////////////////////////////
'alimente la variable LastDateModif avec la date de modif de la fiche
'////////////////////////////////////////////////////////////////////////////////
LastDateModif = mycont.LastModificationTime
 
'////////////////////////////////////////////////////////////////////////////////
'compare la date de modif de la fiche avec la date de modif présente dans la Bdd
'Si la fiche est plus récente, l'enregistrement est mis a jour dans la Bdd
'////////////////////////////////////////////////////////////////////////////////
If LastDateModif > rs.Fields(18) Then
    rs.Edit
    rs.Fields(2) = Nz(mycont.LastName, " ")
    rs.Fields(3) = Nz(mycont.FirstName, " ")
    rs.Fields(4) = mycont.Email1Address
    rs.Fields(1) = Nz(mycont.CompanyName, " ")
    rs.Fields(18) = mycont.LastModificationTime
    rs.Update
End If
 
 
'////////////////////////////////////////////////////////////////////////////////
'compare la date de modif de la fiche avec la date de modif présente dans outlook
'Si la fiche est plus récente, l'enregistrement est mis a jour dans la outlook
'////////////////////////////////////////////////////////////////////////////////
 
'**********************************************************************
' Libération des objets
'**********************************************************************
 
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
 
End Function
Public Sub ParcourirContact()
 
'*************************************************************************
 
' Routine qui va parcourir les enregistrements présents dans le répertoire
 
' contacts et copier les enregistrements manquants dans la base de données
 
' Macro crée pour article DVP par Olivier Lebeau
 
'*************************************************************************
' Modif
'
'
'*************************************************************************
 
Dim oCont As ContactItem
Dim oFold As MAPIFolder
Dim nM As NameSpace
Dim olApp As Outlook.Application
Dim i As Integer
Dim j As Integer
 
j = 1
 
' Affectation des objets
 
Set olApp = CreateObject("Outlook.Application")
Set nM = olApp.GetNamespace("MAPI")
Set oFold = nM.GetDefaultFolder(olFolderContacts)
 
 
i = oFold.Items.Count
 
' Boucle pour parcourir les contacts locaux
 
For j = 1 To i
 
    ' Appel à la fonction AccesADB avec comme paramètre le contactItem
 
    AccesADB (oFold.Items(j))
 
Next j
 
End Sub
 
Public Sub MettreAJourContact()
 
'******************************************************************************
' Procédure pour récupérer les enregistrements présents dans la base de
' données et les injecter dans le répertoire contact.
'******************************************************************************
' Modif
'
'
'*************************************************************************
On Error Resume Next
 
Dim oCont As ContactItem
Dim oCo As ContactItem
Dim oFold As MAPIFolder
Dim nM As NameSpace
Dim olApp As Outlook.Application
Dim stFilt As String
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim LastDateModif As String
 
 
'******************************************************************************
' Affectation des objets
'******************************************************************************
 
Set db = OpenDatabase("C:\tempAcc\contacts.mdb")
Set rs = db.OpenRecordset("Select * From Contacts")
Set olApp = CreateObject("Outlook.Application")
Set nM = olApp.GetNamespace("MAPI")
Set oFold = nM.GetDefaultFolder(olFolderContacts)
 
 
 
'******************************************************************************
' Boucle pour parcourir les enregistrements de la table
'******************************************************************************
While Not rs.EOF
 
'Filtre pour recherche des données déjà existantes dans les contacts locaux
 
stFilt = "[FirstName] = """ & rs.Fields(3)
stFilt = stFilt & """ And [LastName] = """ & rs.Fields(2) & """"
 
' Recherche avec filtre
 
Set oCo = oFold.Items.Find(stFilt)
 
' procédure décisionnelle pour copie des données
 
If oCo = "Nothing" Then
 
    ' Si pas de données, on les ajoute
 
    Set oCont = oFold.Items.Add
 
        oCont.CompanyName = rs.Fields(1)
        oCont.LastName = rs.Fields(2)
        oCont.FirstName = rs.Fields(3)
        oCont.Email1Address = rs.Fields(4)
        oCont.Save
 
 
 
 
End If
 
 
'////////////////////////////////////////////////////////////////////////////////
'compare la date de modif de la fiche avec la date de modif présente dans la Bdd
'Si la fiche de la bdd est plus récente, l'enregistrement est mis a jour dans outlook
'////////////////////////////////////////////////////////////////////////////////
 
LastDateModif = oCont.LastModificationTime
 
If rs.Fields(18) > LastDateModif Then
 
        oCont.CompanyName = rs.Fields(1)
        oCont.LastName = rs.Fields(2)
        oCont.FirstName = rs.Fields(3)
        oCont.Email1Address = rs.Fields(4)
        oCont.Save
 
End If
 
 
' Déplacement vers l'enregistrement suivant.
 
rs.MoveNext
 
Wend
 
 
' Libération des objets
 
rs.Close
 
db.Close
 
Set rs = Nothing
 
Set db = Nothing
 
End Sub

Dans thisoutlooksession :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Application_Startup()
 
Dim strFichier As String
 
    strFichier = "C:\tempAcc\contacts.mdb"
 
    If Dir(strFichier) <> "" And strFichier <> "" Then
 
        MettreAJourContact
 
        ParcourirContact
 
        MsgBox "Base de données Access synchronisée !"
 
    Else
 
        MsgBox "La Base de n'est pas accessible ! Vérifiez la connexion réseau ! La synchronisation ne peut se faire !", vbInformation
 
    End If
 
 
 
 
 
End Sub
 
Private Sub Application_Quit()
 
Dim strFichier As String
 
    strFichier = "C:\tempAcc\contacts.mdb"
 
    If Dir(strFichier) <> "" And strFichier <> "" Then
 
        MettreAJourContact
 
        ParcourirContact
 
        MsgBox "Base de données Access synchronisée !"
 
    Else
 
 
 
    End If
 
End Sub

en piece jointe la bdd
merci pour ton aide

**Oliv-** · 20/06/2008, 09h38

Salut sebinator,
il manque ta fonction NZ

**sebinator** · 20/06/2008, 11h47

a quel niveau ?

**Oliv-** · 20/06/2008, 12h47

Dans AccesADB il y a plusieurs lignes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rs.Fields(2) = Nz(mycont.LastName, " ")

cela fait donc appel à une fonction NZ() qui doit remplacer la valeur null par " " selon moi.

mais cela pose le pb de la comparaison après avec outlook !!

Si tu n'as pas de FIRSTNAME dans outlook tu inscrits " " dans access
puis dans MettreAJourContact()
Set oCo = oFold.Items.Find(stFilt)
où tu filtres sur le nom et le prénom tu compares "" à " "
donc création de doublon.

.

donc on pourrait écrire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
rs.AddNew
    If mycont.LastName <> "" Then rs.Fields(2) = mycont.LastName
    If mycont.FirstName <> "" Then rs.Fields(3) = mycont.FirstName
    If mycont.Email1Address <> "" Then rs.Fields(4) = Nz(mycont.Email1Address, " ")
    If mycont.FirstName <> "" Then rs.Fields(1) = Nz(mycont.FirstName, " ")
    rs.Fields(18) = mycont.LastModificationTime
    rs.Update

maintenant il semble aussi que le filtre ne fonctionne pas lorsque le champs est vide
il faudrait utiliser un filtre comme cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
strFilter = "@SQL=" & Chr(34) & _
        "urn:schemas-microsoft-com:office:office#Keywords" & _
        Chr(34) & " is null"

De même si tu as des homonymes seul le premier sera mis à jour

Il y a quand même pas mal de choses à vérifier

Est ce que Heureux-oli l'utilises sans pb sa macro ? ce serait bien d'avoir ses commentaires comme c'est lui qui l'a écrite

J'essayerais de regarder de nouveau plus tard !

Voici quelques idées d'optimisation aussi :

Je remplacerais par une constante l'emplacement de la bdd

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const MaDatabase = "C:\temp\contacts.mdb"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set db = OpenDatabase(MaDatabase)

serais mieux en dehors de la fonction AccesADB , pour éviter de le créer/fermer à chaque boucle.

Attention à l'utilisation de ON ERROR RESUME NEXT cela peut masquer des points importants à corriger

**Oliv-** · 20/06/2008, 14h42

j'oubliais il faut remplacer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set olApp = CreateObject("Outlook.Application")

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set olApp = Outlook.Application

pour éviter d'avoir le message de sécurité.

**Heureux-oli** · 20/06/2008, 16h30

J'ai vu autre chose.

Pourquoi déclare tu une date en texte ?

Dim LastDateModif As String

Pour les comparaison, ça ne vas pas être simple ?

**Heureux-oli** · 20/06/2008, 17h37

Pour éviter les doublons, on peut aussi récupérer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

EntryID

Je pense qu'il est unique vu sa structure !

00000000DB34F16CF80F9A4A9E9C81E14E18F6FA84262000

Comme Oliv le mentionne, on peut aussi travailler sur les dates

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

LastModificationTime

Comme il y a plusieurs comparaison, je travaillerais avec des fonctions.
Je fais mes tests et en fonction des résultats, j'exécute une fonction ou une autre pour obtenir l'effet désiré.

**sebinator** · 23/06/2008, 15h41

Bonjour,

merci pour votre intervention,

J'ai modifié le code :

J'ai hinibé les on error resume next

J'ai remplacé l'accès à la bdd par une constante

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

(Const MaDatabase = "C:\tempAcc\contacts.mdb")

J'ai modifié le type de données pour lastdatemodif

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim LastDateModif As Date

J'ai modifié les Set olApp = CreateObject("Outlook.Application") par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set olApp = Outlook.Application

(effectivement je n'ai plus le message de sécurité)

Utiliser l'entryID pour éviter les doublons me parait une bonne idée, cela génére effectivement une clé à rallonge certainnement unique :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

0000000041EB6498077BF04E88A9A143D29116D900000000E97A00080000AF02

Je me pose une question concernant l'entryID :
Comment est il généré ?
Si la fiche est créée sur une autre machine est-ce l'ID est identique ?

**Heureux-oli** · 23/06/2008, 16h15

Pour l'ID, je ne sais pas.
On pourrait aussi envisager un ID propre dans un champ pas utilisé.

**sebinator** · 23/06/2008, 17h13

Envoyé par Heureux-oli

Pour l'ID, je ne sais pas.
On pourrait aussi envisager un ID propre dans un champ pas utilisé.

Pour l'id je vais faire un test, comme ça je serais fixé.

Par contre en ayant virer les on resume next j'obtiens une erreur si je modifie une fiche dans la bdd :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'////////////////////////////////////////////////////////////////////////////////
'compare la date de modif de la fiche avec la date de modif présente dans la Bdd
'Si la fiche de la bdd est plus récente, l'enregistrement est mis a jour dans outlook
'////////////////////////////////////////////////////////////////////////////////
 
LastDateModif = oCont.LastModificationTime 
 
If rs.Fields(18) > LastDateModif Then
 
        oCont.CompanyName = rs.Fields(1)
        oCont.LastName = rs.Fields(2)
        oCont.FirstName = rs.Fields(3)
        oCont.Email1Address = rs.Fields(4)
        oCont.Save
 
End If

Cela coince sur la ligne LastDateModif = oCont.LastModificationTime

Variable objet ou variable bloc With non définie (erreur 91)

synchro outlook-access : prob avec les modifs de fiches

VBA Outlook

Discussions similaires

Partager

Partager