Programmer des relances clients avec tableau Excel dans le corps du mail

**kensy** · 15/07/2021, 23h23

Bonjour à tous,

J'ai deux difficultés dans ce sujet.

La première est que je souhaite effectuer une relance sur mes contreparties (nommées "TA"), chaque semaine, sur des dossiers "En cours".

La deuxième est que la relance doit se réaliser par mail, avec un tableau Excel, dans le corps du mail.

Ma base Access fonctionne bien, toutes mes liaisons sont faites, et j'arrive à regrouper les informations à l'aide de requêtes, pour suivre mes dossiers.

Je souhaite avoir une fonction qui va vérifier la date de création de mes demandes, dans la table "Demandes", et si ces dernières sont toujours en statut "En cours", effectuer une relance hebdomadaire sur mes contreparties.

J'ai enregistré un mail pour chaque contrepartie dans un champ nommé "TA_mail", dans la table "TA".

je suis conscient que c'est une demande complexe, et qu'il vous faudra plus d'élément pour fournir un code valide.

je suis à votre disposition si nécessaire.

Voilà une illustration de mes dossiers, avec les divers statuts.

Nom : capture_dossier_en_cours.JPG
Affichages : 250
Taille : 117,7 Ko

Nom : capture_dossier_en_cours.JPG
Affichages : 250
Taille : 117,7 Ko

Je vous remercie pour votre aide.

Cordialement,

Kensy

**hyperion13** · 16/07/2021, 10h28

Salut
Il y a bien la FAQ ici un tuto ici pour vous donner quelques idées de mise en oeuvre.

**kensy** · 17/07/2021, 07h13

Bonjour hyperion13,

Merci pour ce retour.

J'ai appliqué le tuto pour l'envoi programmé des mails.

Chacune de mes contreparties reçoit ses informations, cependant, si elle a plusieurs dossiers en cours, ça lui envoie autant de mail que de dossier.

Autrement dit, si elle a 6 demandes en attente, ça lui envoie 6 mails avec la pièce jointe.

Y-a-t’il une solution pour corriger cela ?

voici le 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
Option Compare Database
Option Explicit
 
 
Public Function IsOutLookRunning() As Boolean
On Error Resume Next
Dim objOutLook As Object
 
    'Référence vers l'objet Application Outlook
    Set objOutLook = GetObject(, "OutLook.Application")
 
    'Si outlook n'est pas ouvert
    If (Err <> 0) Then
        IsOutLookRunning = False
    Else
        IsOutLookRunning = True
    End If
 
Set objOutLook = Nothing
 
End Function
 
Function EnvoiEmail(cheminfichier As String, TA_mail As String, Objet_Message As String, Corps_Message As String, objOutLook As Object) As Boolean
 
    'On Error GoTo Erreur_EnvoiEMail
    Dim objMessage As Object ' Outlook.MailItem ' variable objet pour faire référence au mail
 
    Set objMessage = objOutLook.createitem(0) ' création de l'objer Outlook.MailItem
 
    With objMessage
        .To = TA_mail ' on copie l'adresse mail du destinataire
        .Subject = Objet_Message ' on copie l'objet du message
        'Corps du message
        .BodyFormat = 3 'olFormatRichText : on définit le format Texte enrichi
        .HTMLBody = Corps_Message
 
        If (cheminfichier <> "") Then ' si un chemin de fichier est passé en argument
            objMessage.Attachments.Add cheminfichier ' on attache le fichier au mail
        End If
 
        .Display ' envoi de l'e-mail
         EnvoiEmail = True  ' on indique que tout c'est bien passé
 
    End With
 
    'Libérer la mémoire
    Set objMessage = Nothing
 
    ' on sort de la fonction
    Exit Function
 
Erreur_EnvoiEmail:
    ' Gestion de l'erreur
    Select Case Err.Number
 
        Case -2147467259  ' adresse invalide
            MsgBox "Adresse e-mail invalide"
 
        Case 2501
        MsgBox Err.Number & " " & Err.Description
 
    End Select
 
    ' si le message n'a pas été envoyé on le signale en renvoyant la valeur False
     EnvoiEmail = False
 
End Function
 
Public Function EnvoiDocuments(Optional Automatique As Boolean = False) As Boolean
    'Automatique : argument optionnel indiquant si la fonction s'exécute automatiquement ou pas.
    On Error GoTo err_EnvoiDocuments
    Dim fso As Object ' variable objet FSO
    Dim nomDossier As String ' variable pour le nom du dossier de sauvegarde des documents pdf
    Dim cheminfichier As String ' variable pour le chemin complet du document pdf
    Dim TA_nom As String ' nom du TA
    Dim db As DAO.Database ' variable objet pour faire référence à la base de données
    Dim rsMsg As DAO.Recordset ' variable objet pour faire référence au recordset lié au message à envoyer
    Dim rsRelance As DAO.Recordset ' variable objet pour faire référence au recordset lié aux réabonnements
    Dim objOutLook As Object ' variable objet pour faire référence à l'application Outlook
 
    Set db = CurrentDb ' référence à la base de données courante
 
    ' on ouvre le recordset basé sur la table T_Message_Reabonnement
    Set rsMsg = db.OpenRecordset("Message_Relance", dbOpenSnapshot)
 
    ' on vérifie si l'objet et le corps du message ont été saisis
    If Nz(rsMsg!Objet_Message, "") = "" Then
        MsgBox ("Saisir un objet pour le message des destinataires !")
        Exit Function
    End If
 
    If Nz(rsMsg!Corps_Message, "") = "" Then
        MsgBox ("Saisir un message pour les destinataires !")
        Exit Function
    End If
 
    ' on ouvre le recordset contenant la liste des réabonnement en attente n'ayant pas encore fait l'objet d'un envoi
    Set rsRelance = db.OpenRecordset("select * from R_Relance_TA where (Envoi=False) and nz(TA_mail,"""")<>"""";", dbOpenDynaset)
 
    If Not rsRelance.EOF Then ' s'il y a des documents à envoyer
 
        If MsgBox("Souhaitez-vous envoyer les documents pour les relances ?", vbYesNo + vbQuestion) = vbYes Then ' si on confirme l'envoi
 
            ' Teste si outlook est ouvert, si pas ouvert le lance :
            If Not IsOutLookRunning() Then
                Dim oShell As Object
                Set oShell = CreateObject("WScript.Shell")
                oShell.Run "outlook"
                Set oShell = Nothing
            End If
 
            'Assigner l'objet Outlook
            Set objOutLook = CreateObject("Outlook.Application") 'New Outlook.Application
 
            ' création de l'objet FSO
            Set fso = CreateObject("Scripting.FileSystemObject")
 
            ' indique le chemin du dossier de destination pour les fichiers générés, si pas de dossier d'enregistré dans la table T_Dossier_Documents,
            ' alors copie le chemin du dossier situé dans le répertoire de la base de données Access
            nomDossier = Nz(DLookup("CheminDossier", "T_Dossier_Documents"), CurrentProject.Path & "\Relances") ' indiquez ici le chemin de votre dossier de destination pour les fichiers pdf
 
            If Dir(nomDossier, vbDirectory) = "" Then  '
                fso.CreateFolder nomDossier
            End If
 
            Do Until rsRelance.EOF  ' on parcourt la liste des abonnements à renouveler
 
                TA_nom = rsRelance!TA_nom  ' on copie le nom complet du TA dans la variable
 
                ' on copie le chemin complet dans la variable
                cheminfichier = nomDossier & "\Relances " & TA_nom & ".pdf"
 
                ' ouverture de l'état filtré avec l'identifiant du TA
                DoCmd.OpenReport "E_Relance_TA", acViewPreview, , "TA_id=" & rsRelance!TA_id
 
                ' génération du document pdf à partir de l'état filtré avec l'identifiant du TA
                DoCmd.OutputTo acOutputReport, "E_Relance_TA", "PDF", cheminfichier
 
                ' fermeture de l'état
                DoCmd.Close acReport, "E_Relance_TA"
 
                ' envoi du message au destinataire
                If EnvoiEmail(cheminfichier, rsRelance!TA_mail, rsMsg!Objet_Message, rsMsg!Corps_Message, objOutLook) Then ' si l'envoi du mail s'est bien passé
                    rsRelance.Edit
                    rsRelance!Tr_date_relance = Date   ' on met à jour le champ Tr_date_relance pour indiquer que l'envoi a bien été effectué
                    rsRelance.Update
                End If
 
                ' on passe à l'enregistrement suivant
                rsRelance.MoveNext
 
            Loop
 
            EnvoiDocuments = True ' on indique que les documents ont été envoyés
            MsgBox "Documents envoyés !", vbExclamation ' on affiche un message pour indiquer que les documents ont bien été envoyés
 
        End If
 
    Else ' sinon, si pas de document à envoyer
 
        If Not Automatique Then ' si la fonction ne s'exécute pas à l'ouverture de la base
            MsgBox "Pas de document à envoyer pour les relances !", vbExclamation ' on affiche un message pour indiquer qu'il n'y a pas d'abonnement à renouveler
        End If
 
        EnvoiDocuments = False ' la fonction renvoie False
 
    End If
 
err_EnvoiDocuments:
 
    'gestion d'erreur
    If Err.Number <> 0 And Not EnvoiDocuments Then ' si une erreur s'est produite et que les documents n'ont pas été envoyés
        MsgBox Err.Description, vbExclamation ' on affiche le message d'erreur
        MsgBox "Erreur au cours de l'envoi !", vbExclamation
        EnvoiDocuments = False
    End If
 
    ' libère les variables objet
    Set fso = Nothing
 
    If Not (rsMsg Is Nothing) Then
        rsMsg.Close
    End If
 
    If Not (rsRelance Is Nothing) Then
        rsRelance.Close
    End If
 
    Set rsMsg = Nothing
    Set rsRelance = Nothing
 
    Set db = Nothing
    Set objOutLook = Nothing
 
End Function

Merci pour votre aide.

Cordialement,

Kensy

**User** · 17/07/2021, 15h30

Bonjour,

Si vous souhaitez grouper vos envois par client, je pense que le plus simple, c'est de faire un regroupement sur les client au niveau du SQL lors de l'ouverture du recordset, quelque chose comme ça :

Code VBA :

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

set rsRelance = db.OpenRecordset("select IdClient, NomClient,EmailClient from R_Relance_TA where (Envoi=False) and nz(TA_mail,"""")<>""" group by IdClient, NomClient, EmailClient";")

Ensuite, filtrer l'état qui va servir de base au document à envoyer, sur l'IDClient, avec quelque chose comme :

Code VBA :

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

 DoCmd.OpenReport "E_Relance_TA", acViewPreview, , "IdClient=" & rsRelance!IdClient

Après pour mettre à jour la date de relance (Tr_date_relance), il faut utiliser une requête car les group by interdisent la modification des données :

Code VBA :

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

db.Execute "update R_Relance_TA set [Tr_date_relance]=Date() where IDClient=" & rsRelance!IdClient, dbFailOnError

Je vous laisse adapter tout ça..

Cdlt,

**kensy** · 18/07/2021, 15h26

Bonjour User,

J'ai adapté au mieux votre code à mon projet, cependant j'obtiens le même résultat.

Je pense que le problème vient du fait que la boucle du code était adaptée pour des relances sur des individus distincts.

Il y avait une ligne par individu.

Alors que mon projet regroupe plusieurs lignes pour une entité.

J'ai fait plusieurs test, en modifiant l'emplacement du "Do Until" de la boucle, ou en remplaçant par "Do while".

J'arrive seulement à faire un mail, pour la première entité du tableau.

Voici le 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
Public Function EnvoiDocuments(Optional Automatique As Boolean = False) As Boolean
    'Automatique : argument optionnel indiquant si la fonction s'exécute automatiquement ou pas.
 
    Dim fso As Object ' variable objet FSO
    Dim nomDossier As String ' variable pour le nom du dossier de sauvegarde des documents pdf
    Dim cheminfichier As String ' variable pour le chemin complet du document pdf
    Dim TA_nom As String ' nom du TA
    Dim db As DAO.Database ' variable objet pour faire référence à la base de données
    Dim rsMsg As DAO.Recordset ' variable objet pour faire référence au recordset lié au message à envoyer
    Dim rsRelance As DAO.Recordset ' variable objet pour faire référence au recordset lié aux relances
    Dim objOutLook As Object ' variable objet pour faire référence à l'application Outlook
 
    Set db = CurrentDb ' référence à la base de données courante
 
    ' on ouvre le recordset basé sur la table Message_Relance
    Set rsMsg = db.OpenRecordset("Message_Relance", dbOpenSnapshot)
 
    ' on vérifie si l'objet et le corps du message ont été saisis
    If Nz(rsMsg!Objet_Message, "") = "" Then
        MsgBox ("Saisir un objet pour le message des destinataires !")
        Exit Function
    End If
 
    If Nz(rsMsg!Corps_Message, "") = "" Then
        MsgBox ("Saisir un message pour les destinataires !")
        Exit Function
    End If
 
    ' on ouvre le recordset contenant la liste des transferts en attente n'ayant pas encore fait l'objet d'un envoi
       Set rsRelance = db.OpenRecordset("select TA_id,TA_nom, TA_mail from R_Relance_TA where (Envoi=False) and nz(TA_mail,"""")<>""group by TA_id,TA_nom, TA_mail"";")
 
 
    If Not rsRelance.EOF Then ' s'il y a des documents à envoyer
 
        If MsgBox("Souhaitez-vous envoyer les documents pour les relances ?", vbYesNo + vbQuestion) = vbYes Then ' si on confirme l'envoi
 
            ' Teste si outlook est ouvert, si pas ouvert le lancer :
            If Not IsOutLookRunning() Then
                Dim oShell As Object
                Set oShell = CreateObject("WScript.Shell")
                oShell.Run "outlook"
                Set oShell = Nothing
            End If
 
            'Assigner l'objet Outlook
            Set objOutLook = CreateObject("Outlook.Application") 'New Outlook.Application
 
            ' création de l'objet FSO
            Set fso = CreateObject("Scripting.FileSystemObject")
 
            ' indique le chemin du dossier de destination pour les fichiers générés, si pas de dossier d'enregistré dans la table T_Dossier_Documents,
            ' alors copie le chemin du dossier situé dans le répertoire de la base de données Access
            nomDossier = Nz(DLookup("CheminDossier", "T_Dossier_Documents"), CurrentProject.Path & "\Relances") ' indiquez ici le chemin de votre dossier de destination pour les fichiers pdf
 
 
 
            If Dir(nomDossier, vbDirectory) = "" Then  '
                fso.CreateFolder nomDossier
            End If
 
            Do
                TA_nom = rsRelance!TA_nom  ' on copie le nom complet du TA dans la variable
 
                ' on copie le chemin complet dans la variable
                cheminfichier = nomDossier & "\Relances " & TA_nom & ".pdf"
 
                ' ouverture de l'état filtré avec l'identifiant du TA
                DoCmd.OpenReport "E_Relance_TA", acViewPreview, , "TA_id=" & rsRelance!TA_id
 
                ' génération du document pdf à partir de l'état filtré avec l'identifiant du TA
                DoCmd.OutputTo acOutputReport, "E_Relance_TA", "PDF", cheminfichier
 
                ' fermeture de l'état
                DoCmd.Close acReport, "E_Relance_TA"
 
                ' envoi du message au destinataire
                If EnvoiEmail(cheminfichier, rsRelance!TA_mail, rsMsg!Objet_Message, rsMsg!Corps_Message, objOutLook) Then ' si l'envoi du mail s'est bien passé
 
                    db.Execute "update R_Relance_TA set [Tr_date_relance]=Date() where TA_id=" & rsRelance!TA_id, dbFailOnError
                End If
 
              ' on passe à l'enregistrement suivant
                rsRelance.MoveNext
 
            Loop While rsRelance.EOF  ' on parcourt la liste des relances à réaliser
 
 
            EnvoiDocuments = True ' on indique que les documents ont été envoyés
            MsgBox "Documents envoyés !", vbExclamation ' on affiche un message pour indiquer que les documents ont bien été envoyés
 
        End If
 
    Else ' sinon, si pas de document à envoyer
 
        If Not Automatique Then ' si la fonction ne s'exécute pas à l'ouverture de la base
            MsgBox "Pas de document à envoyer pour les relances !", vbExclamation ' on affiche un message pour indiquer qu'il n'y a pas d'abonnement à renouveler
        End If
 
        EnvoiDocuments = False ' la fonction renvoie False
 
    End If
 
 
    ' libère les variables objet
    Set fso = Nothing
 
    If Not (rsMsg Is Nothing) Then
        rsMsg.Close
    End If
 
    If Not (rsRelance Is Nothing) Then
        rsRelance.Close
    End If
 
    Set rsMsg = Nothing
    Set rsRelance = Nothing
 
    Set db = Nothing
    Set objOutLook = Nothing
 
End Function

Qu'en pensez-vous ?

Cordialement,

Kensy

**User** · 18/07/2021, 19h51

Bonsoir,

Il faut que tu garde le Do Until rsRelance.EOF ou alors tu fais Do while Not rsRelance.EOF.

Peux tu poster une image de l'affichage de ta requête R_Relance_TA pour qu'on comprenne mieux les choses au niveau des données et des regroupement à faire ?

Cdlt,

**kensy** · 18/07/2021, 20h43

User,

voici mon code SQL :

Code :

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

1
2
3
SELECT Demandes.Dem_id, TA.TA_id, TA.TA_nom, TA.TA_mail, Demandes.Dem_date, Transferts.Tr_date_relance, Transferts.Tr_date_cloture, Transferts.Tr_id, Transferts.Tr_sens, Transferts.Tr_quantite, Transferts.Tr_nostro, Transferts.Tr_code, Transferts.Tr_CBO, Valeurs.valeur_nom, Valeurs.valeur_code, Transferts.Tr_statut, Transferts.Tr_cpt_registre, Affilies.aff_code, Affilies.aff_nom, Demandes.Dem_document, DateAdd("d",7,[Dem_date]) AS DateEcheance, (Nz([Tr_date_cloture],#1/1/1000#))>[Dem_date] And (Nz([Tr_date_cloture],#1/1/1000#)+7<Date()) AS Envoi
FROM (TA INNER JOIN ((Comptes INNER JOIN SDG ON Comptes.Compte_id = SDG.SDG_compte_id) INNER JOIN Valeurs ON SDG.SDG_id = Valeurs.valeur_SDG_id) ON TA.TA_id = Comptes.Compte_TA_id) INNER JOIN ((Affilies INNER JOIN Demandes ON Affilies.aff_code = Demandes.Dem_affilie_id) INNER JOIN Transferts ON Demandes.Dem_id = Transferts.Tr_demande_id) ON Valeurs.valeur_code = Transferts.Tr_valeur
WHERE (((Transferts.Tr_statut)="En cours"));

Voici la capture d'écran : Nom : requete relance.JPG
Affichages : 240
Taille : 97,1 Ko

La suite:

Nom : requete relance 3.JPG
Affichages : 178
Taille : 113,8 Ko

Mon état est paramétré sur cette requête et affiche les transferts pour chaque "TA"

Cordialement,

Kensy

**User** · 18/07/2021, 21h04

Si on reprend la requête de regroupement :

Code sql :

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

select TA_id, TA_nom, TA_mail from R_Relance_TA where (Envoi=False) and nz(TA_mail,"")<>"" group by TA_id, TA_nom, TA_mail;

Tu peux l'essayer dans l'éditeur SQL pour tester ce que cette requête te renvoie et si ça correspond à ce que tu veux.

Et pour l'ouverture du recordset cela donnerait donc :

Code VBA :

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

Set rsRelance = db.OpenRecordset("select TA_id, TA_nom, TA_mail from R_Relance_TA where (Envoi=False) and nz(TA_mail,"""")<>"" group by TA_id, TA_nom, TA_mail;")

Cdlt,

**kensy** · 18/07/2021, 22h16

User,

Cette ligne bloque le code :

Code :

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

Set rsRelance = db.OpenRecordset("select TA_id, TA_nom, TA_mail from R_Relance_TA where (Envoi=False) and nz(TA_mail,"""")<>"" group by TA_id, TA_nom, TA_mail;")

Sinon pour ton code SQL j'ai procédé ainsi :

Nom : Requete SQL code.JPG
Affichages : 163
Taille : 26,3 Ko

Nom : Requete SQL.JPG
Affichages : 177
Taille : 65,2 Ko

Nom : Requete SQL résultat.JPG
Affichages : 157
Taille : 47,4 Ko

Est ce que je dois baser mon code VBA sur cette requête ?

Merci pour ton aide.

Cordialement,

Kensy

**User** · 19/07/2021, 12h19

Bonjour,

Est ce que je dois baser mon code VBA sur cette requête ?

Si les données correspondent à ce que tu veux, tu peux en effet enregistrer ta requête basée sur le sql que je t'ai donné, en lui donnant un nom comme "R_Relances", puis ensuite la mettre sur ouverture du recordset :

Code :

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

Set rsRelance = db.OpenRecordset("R_Relances")

Tu peux aussi essayer :

Code :

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

Set rsRelance = db.OpenRecordset("select TA_id, TA_nom, TA_mail from R_Relance_TA where (Envoi=False) and nz(TA_mail,"""")<>"""" group by TA_id, TA_nom, TA_mail;")

Attention à bien basé l'état, comme tu l'as déjà fait, sur la requête R_Relance_TA.

Cdlt,

**kensy** · 19/07/2021, 13h03

Bonjour,

Il y a un souci avec cette ligne:

Code :

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

Set rsRelance = db.OpenRecordset("select TA_id, TA_nom, TA_mail from R_Relance_TA where (Envoi=False) and nz(TA_mail,"""")<>"""" group by TA_id, TA_nom, TA_mail;")

peut-être à cause du positionnement des guillemet à la fin.

et la requête SQL, ne fonctionne pas malheureusement.

Cordialement,

Kensy

**User** · 19/07/2021, 13h34

Si le code s'arrête à la ligne en question, as-tu un message d'erreur ?

Sinon, tu avais affiché le résultat de la requête R_Relance_TA_2 :

Nom : Requete SQL résultat.JPG
Affichages : 140
Taille : 47,4 Ko

Nom : Requete SQL résultat.JPG
Affichages : 140
Taille : 47,4 Ko

Ensuite, il n'y a qu'à faire :

Code vba :

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

Set rsRelance = db.OpenRecordset("R_Relance_TA_2")

En vba, on double les guillemets dans le code sql, mais pas dans l'éditeur SQL, quand tu crées la requête.

Cdlt,

**kensy** · 19/07/2021, 15h19

Si je comprends bien tu me proposes d'utiliser 2 requêtes ?

Une pour les lignes en attente, et une autre un pour les TA?

Maintenant, le code s’arrête ici :

Code :

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

db.Execute "update R_Relance_TA set [Tr_date_relance]=Date() where TA_id=" & rsRelance!TA_id, dbFailOnError

Nom : Message_erreur_2.JPG
Affichages : 144
Taille : 15,4 Ko

Cordialement,

Kensy

**User** · 19/07/2021, 16h00

Oui, ta requête d'origine R_Relance_TA comme source de l'état et la requête avec regroupement R_Relance_TA_2, sur le recordset :

Code vba :

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

Set rsRelance = db.OpenRecordset("R_Relance_TA_2")

Maintenant, le code s’arrête ici :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
db.Execute "update R_Relance_TA set [Tr_date_relance]=Date() where TA_id=" & rsRelance!TA_id, dbFailOnErrorDE]

Cela veut simplement dire que ta requête d'origine R_Relance_TA ne permet pas la mise à jour des données, tu ne peux pas saisir de données dedans.
Je pensais qu'au début tu pouvais

Fais juste un essai sans cette ligne db.Execute "update...".

Cdlt,

**kensy** · 19/07/2021, 16h38

J'ai modifié pas mal de truc et ça fonctionne:

J'ai supprimé (Envoi=False), ça ne voulait pas l'afficher dans la requête:

Code :

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

Set rsRelance = db.OpenRecordset("select TA_id, TA_nom, TA_mail from R_Relance_TA_2 where nz(TA_mail,"""")<>"""" group by TA_id, TA_nom, TA_mail;")

Et j'ai modifié l'endroit pour la mise a jour de la date :

Code :

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

db.Execute "update Transferts set [Tr_date_relance]=Date() where Tr_id=" & rsRelance!TA_id, dbFailOnError

Je te remercie beaucoup.

J'ai une dernière question, sais-tu comment je peux afficher dans ma requête R_Relance_TA, les opérations qui sont à plus de 7 jours de leur date de création,

Et que la relance s'exécute une fois par semaine ?

Cordialement,

Kensy

**User** · 19/07/2021, 17h10

je dirais que pour avoir les opérations qui sont a plus de 7 jours de leur date de création, j'utiliserais dans ta requête l'expression :

Code :

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

Apres7Jours : DateAdd("d";7;[DateCreation]) < Date()

ou :

Code :

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

Apres7Jours : DateDiff("d";[DateCreation];Date()) > 7

En supposant que ton champ se nomme [DateCreation].

Ensuite, pour filtrer j'ajouterais une condition Vrai sous le champ calculé, en sql ça ferait :

Code :

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

Where DateAdd("d",7,[DateCreation]) < Date()

Pour les relances toutes les semaines, je ferais :

Code :

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

RelanceApres7Jours : DateAdd("d";7;[Tr_date_relance])<=Date()

qui va te renvoyer Vrai (True) si la date de la dernière relance est dépassée de 7 jours.

En supposant que tu mettes à jour le champ [Tr_date_relance] tous les 7 jours.

Cdlt,

**kensy** · 19/07/2021, 22h12

Je suis plus à l'aise avec l'éditeur de requête alors j'ai procédé ainsi :

Nom : expression calculée.JPG
Affichages : 121
Taille : 59,7 Ko

Ca donne ça comme résultat :

Nom : expression calculée 2.JPG
Affichages : 134
Taille : 68,8 Ko

je ne sais pas si j'ai bien utilisé le code suivant :

Code :

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

Where DateAdd("d",7,[DateCreation]) < Date()

voici mon code SQL :

Code SQL :

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

1
2
3
SELECT Demandes.Dem_id, TA.TA_id, Transferts.Tr_id, TA.TA_nom, TA.TA_mail, Demandes.Dem_date, Transferts.Tr_date_relance, Transferts.Tr_date_cloture, Transferts.Tr_id, Transferts.Tr_sens, Transferts.Tr_quantite, Transferts.Tr_nostro, Transferts.Tr_code, Transferts.Tr_CBO, Valeurs.valeur_nom, Valeurs.valeur_code, Transferts.Tr_statut, Transferts.Tr_cpt_registre, Affilies.aff_code, Affilies.aff_nom, Demandes.Dem_document, DateAdd("d",7,[Dem_date])<Date() AS Apres7Jours, DateAdd("d",7,[Tr_date_relance])<=Date() AS RelanceApres7Jours, (Nz([Tr_date_cloture],#1/1/1000#))>[Dem_date] And (Nz([Tr_date_cloture],#1/1/1000#)+7<Date()) AS Envoi
FROM (TA INNER JOIN ((Comptes INNER JOIN SDG ON Comptes.Compte_id = SDG.SDG_compte_id) INNER JOIN Valeurs ON SDG.SDG_id = Valeurs.valeur_SDG_id) ON TA.TA_id = Comptes.Compte_TA_id) INNER JOIN ((Affilies INNER JOIN Demandes ON Affilies.aff_code = Demandes.Dem_affilie_id) INNER JOIN Transferts ON Demandes.Dem_id = Transferts.Tr_demande_id) ON Valeurs.valeur_code = Transferts.Tr_valeur
WHERE (((Transferts.Tr_statut)="En cours") AND ((DateAdd("d",7,[Dem_date])<Date())=DateAdd("d",7,[Dem_date])<Date()));

C'était bien cela ?

Cordialement,

Kensy

**User** · 20/07/2021, 07h39

Bonjour,

C'est plus simple je crois, au niveau du where tu fais :

Code SQL :

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

1
2
3
SELECT ...
FROM ...
WHERE (((Transferts.Tr_statut)="En cours") AND (DateAdd("d",7,[Dem_date])<Date())

Si le champ [Dem_date] correspond à la date de création.

ça revient à mettre Vrai ou True sur la ligne Critères en dessous du champ [Apres7Jours].

Cdlt,

**kensy** · 20/07/2021, 09h42

Bonjour,

J'ai rajouté une parenthèse à la fin, car j'avais le message suivant :

Nom : expression calculée erreur.JPG
Affichages : 117
Taille : 50,2 Ko

En suite, ça donne cela dans l'éditeur de requête :

Nom : expression calculée 1.JPG
Affichages : 108
Taille : 24,6 Ko

En résultat :

Nom : expression calculée 2.JPG
Affichages : 110
Taille : 22,9 Ko

C'est bien ça ?

C'est top déjà, les anciennes demandes sont affichées.

Est ce que je peux abuser ? Est-t-il possible de déclencher automatiquement les relances, sans intervention humaine?

Cordialement,

Kensy

**User** · 20/07/2021, 12h19

Est ce que je peux abuser ? Est-t-il possible de déclencher automatiquement les relances, sans intervention humaine?

Tu as la possibilité par exemple d'exécuter la procédure sur l'événement ouverture du formulaire d'accueil (formulaire que tu mets au démarrage de la base).
Ou bien tu choisis de l'exécuter sur minuterie (événement sur minuterie) d'un formulaire qui resterais toujours ouvert. Il faut alors que tu définisse l'intervalle minuterie en milliseondes (exemple 1h = 3600 * 1000 ms) :

Nom : formulaire_accueil.png
Affichages : 155
Taille : 22,9 Ko