synchro outlook-access : prob avec les modifs de fiches

[sebinator]

Bonjour,

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


Code :

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
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-]

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]

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-]

Salut,
c'est la propriété

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

[sebinator]

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-]

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]

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 :

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-]

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

Code :

oCont.Save

le champs

Code :

mycont.LastModificationTime

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

[sebinator]

J'essaye avec save et ca ne fonctionne pas.

voila ce que j'ai mis :

Code :

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-]

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

[sebinator]

voici le code

Dans un module :

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
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 :

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-]

Salut sebinator,
il manque ta fonction NZ

[sebinator]

a quel niveau ?

[Oliv-]

Dans AccesADB il y a plusieurs lignes :

Code :

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 !!

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

.

donc on pourrait écrire :

Code :

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 :

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 :

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

Code :

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-]

j'oubliais il faut remplacer

Code :

Set olApp = CreateObject("Outlook.Application")

par

Code :

Set olApp = Outlook.Application

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

[Heureux-oli]

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]

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

Code :

EntryID

Je pense qu'il est unique vu sa structure !

00000000DB34F16CF80F9A4A9E9C81E14E18F6FA84262000

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

Code :

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]

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 :

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

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

Code :

Dim LastDateModif As Date

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

Code :

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 :

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]

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

[sebinator]

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 :

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)