Dlookup avec critère de date ne fonctionne pas

**clickandgo** · 03/02/2017, 11h53

Bonjour à tous

Ci dessous une fonction de synchro de calendrier Outlook avec Access qui marche parfaitement pour la première partie mais pas la partie "Deuxième passe" qui utilise un Dlookup avec critère de date, à l'éxécution apparait une erreur de syntaxe dans le critère (erreur 464) :

NB: Les variables renvoient bien le bon format de date et le debug.print aussi

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
Public Function SynchroCalendrierOutlook()
 
Dim myOlApp As New outlook.Application
Dim objNamespace As outlook.NameSpace
Dim DossierOutlook As outlook.MAPIFolder
Dim RdvOutlook As outlook.AppointmentItem
Dim FiltreExport As outlook.Items
Dim FiltreImport As outlook.Items
Dim item As Object
Dim Found As Boolean
Dim T As Double
Dim rstRdv As DAO.Recordset
Dim rstImport As DAO.Recordset
Dim Compteur As Single
Dim LigneRdvActif As String
 
Set objNamespace = myOlApp.GetNamespace("MAPI")
Set DossierOutlook = objNamespace.GetDefaultFolder(olFolderCalendar)
 
Compteur = 0
T = Timer
Set rstRdv = CurrentDb.OpenRecordset("SELECT t_rendezvous.idaction,t_rendezvous.ajoutéàoutlook,T_RendezVous.HoraireDebut,T_RendezVous.horairefin,T_RendezVous.NotesAction, T_RendezVous.LieuAction, T_RendezVous.RappelAction, T_RendezVous.MinutesRappel, T_RendezVous.NumAction, T_RendezVous.DuréeAction,t_rendezvous.numcontact, [Vendeurs et Intervenants].[Vendeur/Intervenant], RqContacts.Contact " & _
                                             "FROM RqContacts INNER JOIN ([Vendeurs et Intervenants] INNER JOIN T_RendezVous ON [Vendeurs et Intervenants].IdVendeurIntervenant = T_RendezVous.IdIntervenant) ON RqContacts.numContact = T_RendezVous.numContact;")
 
 
   'Première passe : on ajoute les rdv non présents dans Outlook :
 
 
    DoCmd.OpenForm ("dialogbox")
    Forms![dialogbox].txtdialogbox = "Veuillez patienter pendant le procesus de synchronisation"
 
    rstRdv.MoveFirst
 
        Do While Not rstRdv.EOF
 
        Set FiltreExport = DossierOutlook.Items.Restrict("[start]='" & Format("" & rstRdv!HoraireDebut & "", "dd/mm/yyyy hh:mm") & "' and [end]= '" & Format("" & rstRdv!HoraireFin & "", "dd/mm/yyyy hh:mm") & "' and [subject]= """ & rstRdv!Contact & """")
 
         If FiltreExport.Count = 0 Then
 
            LigneRdvActif = LigneRdvActif & "<br>" & Compteur & ". " & Format("" & rstRdv!HoraireDebut & "", "dd/mm/yyyy hh:mm") & " à " & Format("" & rstRdv!HoraireFin & "", "dd/mm/yyyy hh:mm") & " " & rstRdv!Contact
 
            Found = False
 
        Debug.Print Compteur & " " & rstRdv!HoraireDebut, rstRdv!HoraireFin, rstRdv!Contact
 
            'Création du rdv
 
       Set RdvOutlook = myOlApp.CreateItem(olAppointmentItem)
 
 
       With RdvOutlook
 
          .Start = rstRdv!HoraireDebut
          .Duration = rstRdv!DuréeAction
          .Subject = Nz(rstRdv!Contact, "")
          .Body = Nz(rstRdv!NotesAction, "")
          .Location = Nz(rstRdv!LieuAction, "")
          .ReminderMinutesBeforeStart = Nz(rstRdv!MinutesRappel, "")
          .ReminderSet = Nz(rstRdv!RappelAction, "")
 
          .Save
 
       End With
 
 
       ' Définir l'indicateur AjoutéàOutlook, enregistrer, afficher un dialogbox.
 
             CurrentDb.Execute ("update t_rendezvous set t_rendezvous.ajoutéàoutlook = true " & _
             ",t_rendezvous.datecreationoutlook='" & Now() & "' " & _
             "where numaction = " & rstRdv!NumAction & ";")
 
             Compteur = Compteur + 1
 
    Forms![dialogbox].txtdialogbox = "<b>" & "Les " & Compteur & " rdv suivants ont été synchronisés avec Outlook :" & "</b>" & "<br>" & "<br>" & " " & LigneRdvActif
 
                Else
 
            Found = True
 
 
     rstRdv.MoveNext
 
      End If
 
 
        Loop
 
  'Deuxième passe : On propose d'importer un rdv présent dans outlook inexistant dans la table T_RendezVous d' Access
 
 
  For Each RdvOutlook In DossierOutlook.Items
 
    Set FiltreImport = DLookup("[numcontact]", "t_rendezvous", "t_rendezvous.[horairedebut]= '" & Format("" & RdvOutlook.Start & "", "#\dd/mm/yyyy hh:mm\#") & "'")
 
        If FiltreImport.Count > 0 Then
        Debug.Print RdvOutlook.Subject, RdvOutlook.Start
        End If
 
            Next
 
    myOlApp.Quit
Set rstRdv = Nothing
Set rstImport = Nothing
Set myOlApp = Nothing
Set objNamespace = Nothing
Set DossierOutlook = Nothing
 
Debug.Print Timer - T
 
End Function

Si je mets comme syntaxe :

Code :

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

    Set FiltreImport = DLookup("[numcontact]", "t_rendezvous", "t_rendezvous.[horairedebut]= '" & Format("" & RdvOutlook.Start & "", "#\dd/mm/yyyy hh:mm\#") & "'")

Rien ne change

Avez vous une idée d'où vient l'erreur ?

Merci d'avance

**User** · 03/02/2017, 16h54

Bonjour,

Je me rappelle vaguement de votre appli

A 1ère vue je dirais :

Code :

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

1
2
3
if DCount("[numcontact]", "t_rendezvous", "[horairedebut]=#" & Format( RdvOutlook.Start , "mm/dd/yyyy hh:nn") & "#")=0 Then ' si pas de rdv dans la base alors ajouter le rdv
 ...
end if

Cdlt,

**clickandgo** · 04/02/2017, 11h55

Merci beaucoup pour cette solution qui marche très bien

Le problème maintenant c'est que je n'arrive pas à avoir la bonne syntaxe si je mets le dcount en multicritère :

Code :

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

    If DCount("[horairedebut]", "rq_rdv", "rq_rdv.[horairedebut]=#" & Format(RdvOutlook.Start, "dd/mm/yyyy hh:mm:nn") & "# &" AND rq_rdv.[DuréeAction] ="" & RdvOutlook.Duration"") = 0 Then

J'ai tout essayé à chaque fois il me signale une erreur de syntaxe, les champs [duration] et [duréeaction] sont des single, je ne vois pas quelle syntaxe utiliser ...

Merci de m'aiguiller encore une fois

**User** · 04/02/2017, 12h02

Bonjour,

Essayez ceci :

Code :

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

 If DCount("[horairedebut]", "rq_rdv", "rq_rdv.[horairedebut]=#" & Format(RdvOutlook.Start, "dd/mm/yyyy hh:nn") & "# AND rq_rdv.[DuréeAction]=" & RdvOutlook.Duration) = 0 Then

Cdlt,

**clickandgo** · 04/02/2017, 14h55

Cela marche parfaitement avec votre syntaxe mais si je rajoute un 3ème critère ça coince, j'aimerai comprendre pourquoi !

Merci beaucoup d'avance

Code :

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

1
2
3
4
5
6
7
8
9
For Each RdvOutlook In DossierOutlook.Items
 
    If DCount("[horairedebut]", "rq_rdv", "rq_rdv.[horairedebut]=#" & Format(RdvOutlook.Start, "dd/mm/yyyy hh:mm:nn") & "# " & _
              "AND rq_rdv.[DuréeAction] = " & RdvOutlook.Duration " & _
              "AND rq_rdv.[Contact] = " & RdvOutlook.Subject) = 0 Then
 
 
        Debug.Print RdvOutlook.Subject, RdvOutlook.Start
        End If

**User** · 04/02/2017, 15h04

Probablement que le champ contact est du type texte, dans ce cas il faut l'encadrer de quotes (') ou de double guillemets ("") :

Code :

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

1
2
3
4
5
6
7
8
9
For Each RdvOutlook In DossierOutlook.Items
 
    If DCount("[horairedebut]", "rq_rdv", "rq_rdv.[horairedebut]=#" & Format(RdvOutlook.Start, "dd/mm/yyyy hh:mm:nn") & "# " & _
              "AND rq_rdv.[DuréeAction] = " & RdvOutlook.Duration " & _
              "AND rq_rdv.[Contact] = '" & RdvOutlook.Subject & "'") = 0 Then
 
 
        Debug.Print RdvOutlook.Subject, RdvOutlook.Start
        End If

A quand le 4ème critère ?

**clickandgo** · 04/02/2017, 22h16

Après plusieurs corrections l' éditeur accepte le Dcount suivant mais curieusement cela ne filtre pas et m'écris le debug.print pour toutes les valeurs au lieu de seulement la seule et unique que j'ai créée à titre d'exemple uniquement dans le calendrier Outlook ... Il y a donc erreur dans ce filtre ...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
  For Each RdvOutlook In DossierOutlook.Items
 
    If DCount("*", "rq_rdv", "rq_rdv.[horairedebut]=#" & Format(RdvOutlook.Start, "dd/mm/yyyy hh:mm:nn") & "# " & _
              "AND rq_rdv.[DuréeAction] = " & RdvOutlook.Duration & "" & _
              "AND rq_rdv.[Contact] = "" & RdvOutlook.Subject & """) = 0 Then
 
        Debug.Print RdvOutlook.Start, RdvOutlook.Subject, RdvOutlook.Duration
        End If
 
            Next

**User** · 04/02/2017, 22h26

ça doit venir entre autre des dates, il faudrait essayer avec le format "mm/dd/yyyy hh:nn" et réécrire le code comme suit :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
For Each RdvOutlook In DossierOutlook.Items
 
    If DCount("*", "rq_rdv", "rq_rdv.[horairedebut]=#" & Format(RdvOutlook.Start, "mm/dd/yyyy hh:nn") & "#" & _
              " AND rq_rdv.[DuréeAction] = " & RdvOutlook.Duration  & _
              " AND rq_rdv.[Contact] = '" & RdvOutlook.Subject & "'") = 0 Then
 
 
        Debug.Print RdvOutlook.Start, RdvOutlook.Subject, RdvOutlook.Duration
     End If
 
Next

**clickandgo** · 05/02/2017, 01h07

Merci pour cette réponse et pour votre travail

J'ai enfin reussi en mettant cette syntaxe :

Apparemment c'était le champ "Subject" qui posait problème

Code :

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

1
2
3
4
5
6
7
8
9
10
 For Each RdvOutlook In DossierOutlook.Items
 
    If DCount("*", "rq_rdv", "rq_rdv.[horairedebut]=#" & Format(RdvOutlook.Start, "mm/dd/yyyy hh:nn") & "#" & _
              " AND rq_rdv.[DuréeAction] = " & RdvOutlook.Duration & _
              " AND rq_rdv.[Contact] = """ & RdvOutlook.Subject & """") = 0 Then
 
 
        Debug.Print RdvOutlook.Start, RdvOutlook.Subject, RdvOutlook.Duration
     End If
            Next

**User** · 05/02/2017, 11h51

Bonjour,

Dans RdvOutlook.Subject il devait y avoir des quotes ('), il aurait fallu les doubler pour qu'Access fasse la distinction avec les quotes (') qui encadrent le subject :

Code :

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

 " AND rq_rdv.[Contact] = '" & Replace(RdvOutlook.Subject,"'","''") & "'") = 0 Then

C'est pourquoi on préfère encadrer avec les double guillemets ("") car on ne trouve généralement pas de guillemet dans les champs texte :

Code :

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

 " AND rq_rdv.[Contact] = """ & RdvOutlook.Subject & """") = 0 Then

Cdlt,

Dlookup avec critère de date ne fonctionne pas

VBA Access

Discussions similaires

Partager

Partager