Envoyé par
BENNASR
Bonjour TonyNiort79, la forum
Merci pour les efforts déployés et les explications très claires ( au moins pour moi) qui seront très utiles pour plusieurs membres du site et/ou autres internautes passagers
Respect Monsieur et bonne journée
Bonjour BENNASR, bonjour le Forum,
Une variante pour l'envoi d'un mail automatique sous Excel via le Planificateur des tâches de Windows
Cette fois-ci au lieu de se déclencher avec une date ponctuelle (notre précédent cas : tous les lundis),
ce sera Excel avec toute sa magie qui insérera une date dans le Planificateur des tâches suivant un tableau de suivi.
En effet le 1er fichier AB_CreationTache qui ne servait pour le cas précédent qu'une seule fois pour créer la tâche planifiée
sera modifié et exécuté par Excel avec la commande Shell,
puis le jour J à l'heure H, le planificateur des tâches lancera le fichier AC_ qui lancera le fichier AD_ qui lancera Excel …
la boucle est bouclée.
Le nombre de fichiers ne change pas, par contre j'ai changé les noms pour une meilleure lisibilité
Pour cette fois, je prendrai comme exemple le suivi des Habilitations.
Nous aurons donc dans un répertoire " I:\TachePlanifiee\TachePlanAlerteSuiviHabilitations" des fichiers de type :
AB_CreationTacheAlerteSuiviHabilitations.bat qui insérera une date dans le planificateur des tâches
AC_LancementVBS.bat programme Script.exe qui lancera le VBScript
AD_LancementVBAExcel.vbs qui lancera Excel et sa procédure
Vous me direz pourquoi ne pas lancer directement le VBScript directement avec le planificateur des tâches ?
C'est ce que je faisais au début, puis avec les mises à jour, une fenêtre s'ouvrait et me demandait :
Avec quel programme voulez-vous ouvrir le fichier AD_LancementVBAExcel.vbs ?
Je n'ai plus de problèmes avec le fichier intermédiaire AC où j'indique clairement le Script.exe.
Passons au premier fichier qui cette fois-ci aura la commande ONCE (tâche unique) au lieu de WEEKLY (tâche hebdomadaire)
AB_creationTacheAlerteSuiviHabilitations.bat.txt
N'oublions pas d'enlever l'extension .txt
Quelques explications sur ce "Batch file" (fichier batch)
schtasks.exe Programme Planificateur des tâches
/create création d'une tâche planifiée
/TN "AlerteSuiviHabilitations" Nom de la tâche planifiée (TaskName)
/F Une valeur qui crée avec force la tâche et supprime les avertissements si la tâche spécifiée existe déjà (aide Windows)
/SC ONCE tâche unique qui ne s'exécutera qu'une seule fois, mais Excel prendra le relais pour la boucle dans sa procédure
/SD date de départ de la tâche planifiée (StartDate), si vous lancez la procédure avec Excel,
mettre la Date du jour car quand le Planificateur des tâches se déclenchera,
Excel remplacera la date du jour par la prochaine date à planifier.
/ST heure de départ de la tâche planifiée (StartTime)
/TR le chemin et le nom du fichier Batch à lancer (les lettres AC servent uniquement pour l'ordre chronologique des événements)
Pour des adaptations beaucoup d'exemples très utiles (voir dans les pages plus bas) :
https://docs.microsoft.com/en-us/pre...ectedfrom=MSDN
Vérification de la nouvelle tâche, double-clic sur le Planificateur des tâches, voir dans la bibliothèque du Planificateur de tâches à gauche)
Cette fois-ci, je sélectionne la tâche " AlerteSuiviHabilitations " qui se trouve sur la droite en bas
Puis plus bas sur l'onglet "Déclencheurs", puis onglet "Actions"
Si nous voulons modifier les paramètres nous pouvons toujours le faire :
Soit manuellement
Soit en modifiant le fichier sans modifier le nom de la tâche, puis double-clic
AC_LancementVBS.bat et AD_LancementVBAExcel.vbs, vous connaissez la procédure : cette fois-ci la macro s'appellera "AlerteSuiviHabilitationsTachePlanifieeReconduction"
nom très long j'en conviens, mais chacun est libre du nom
Enfin le fichier Excel : Suivi Des Habilitations.xls
Le cahier des charges
(citation qui me plaît beaucoup empruntée à Pierre Fauconnier dont je salue au passage, moi qui croyait connaître parfaitement la fonction RechercheV, à savoir une seule commande, Je m'aperçois après lecture de son tutoriel que ma palette ne contenait qu'une seule couleur, un conseil à tous, aller visiter les Tutos de Pierre Fauconnier même pour les fonctions les plus simples, et votre palette sera beaucoup plus riche, n'oublions pas non-plus tous les autres qui ont contribués à élargir mes connaissances dans beaucoup de domaines),
Revenons au cahier des charges :
Ouverture d'Excel à la prochaine date de reconduction des habilitations,
Pour cela nous ferons un filtre automatique des habilitations concernées,
Création d'un PDF puis envoi d'un mail aux destinataires suivant :
1er destinataire : moi-même pour me rappeler
2ème destinataire : mon supérieur hiérarchique pour l'aviser
3ème destinataire : le responsable des reconductions des habilitations
Bien entendu, je n'oublie pas l'onglet "Signature_Mails" qui pourra être masqué pour éviter toutes modifications
En "A2" la procédure insèrera le texte suivant une plusieurs lignes trouvées
et enfin la procédure
dans cette procédure il y a 2 sauts au cas où il n'y a pas de création de PDF et du coup rien à envoyer
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
| Sub AlerteSuiviHabilitationsTachePlanifieeReconduction()
Dim DateMiniReconduction As Date 'Reconduction tous les 2 ans
Dim ZoneFiltreAutomatique As Range ' Plage zone tableau filtre automatique
Sheets("Feuille1").Select
Range("A10:R10").Select
Set ZoneFiltreAutomatique = Range(Selection, Selection.End(xlDown)) 'affectation de la plage du filtre automatique
Dim ZoneImpression As Range ' Plage Zone d'impression
Dim QuantiteLignes As Integer
Sheets("Feuille1").Select
Range("A10").Select
QuantiteLignes = Range(Selection, Selection.End(xlDown)).Count
Set ZoneImpression = Range("A1:R" & 9 + QuantiteLignes) 'affectation de la zone d'impression soit zone impression plus 9 premieres lignes
Sheets("Feuille1").Select
'Enlevement filtres automatiques
With Worksheets("Feuille1")
If .FilterMode = True Then .ShowAllData
End With
'nombre de dates uniques pour l'organisme Reconduction soit tous les 2 ans
Dim DateReconductionUnique As Integer
Dim I As Long
Dim colNbrReconduction As New Collection
I = 11 ' Ici on demarre en ligne 11
Do While ThisWorkbook.Worksheets("Feuille1").Range("E" & I).Value <> ""
On Error Resume Next
colNbrReconduction.Add ThisWorkbook.Worksheets("Feuille1").Range("E" & I).Value, CStr(ThisWorkbook.Worksheets("Feuille1").Range("E" & I).Value)
I = I + 1
Loop
DateReconductionUnique = colNbrReconduction.Count
' attribution nouvelle date Reconduction superieure a la date du jour (pour la tache planifiee)
Dim PlageDateReconduction As Range
Sheets("Feuille1").Select
Range("E10").Select
Set PlageDateReconduction = Range(Selection, Selection.End(xlDown)) 'affectation de la plage des dates Organisme Reconduction
Dim PetiteValeurReconduction As Date
Dim CompteurPetiteValeurReconduction As Integer
CompteurPetiteValeurReconduction = 1
While Date >= PetiteValeurReconduction
PetiteValeurReconduction = WorksheetFunction.Small(PlageDateReconduction, CompteurPetiteValeurReconduction)
CompteurPetiteValeurReconduction = CompteurPetiteValeurReconduction + 1
Wend
CompteurPetiteValeurReconduction = CompteurPetiteValeurReconduction - 1
DateMiniReconduction = WorksheetFunction.Small(PlageDateReconduction, CompteurPetiteValeurReconduction) 'pour les taches planifiees
'recherche QualificationsHabilitations perimees a la date du jour
Dim DateReconductionPerimee As Date
If Application.Min(Columns("E:E")) < Date Then
ZoneFiltreAutomatique.AutoFilter Field:=5, Criteria1:="<=" & Format(Date, "mm/dd/yyyy"), Operator:=xlAnd
'creation du fichier PDF QualificationsHabilitations perimees
Dim NomPdfReconductionPerimee As String
Dim CheminFichier As String
CheminFichier = "I:\TachePlanifiee\TachePlanAlerteSuiviHabilitations\SuiviHabilitations"
NomPdfReconductionPerimee = CheminFichier & "\" & "Reconduction Habilitation par organisme (tous les 2 ans).pdf"
Dim CompteurHabilitationsPerimee As Integer
Dim QualificationsHabilitations2ansPerimee As String
CompteurHabilitationsPerimee = WorksheetFunction.Subtotal(3, PlageDateReconduction) - 1
'Saut Du premier Pave de commande s'il n'y a rien a envoyer
If CompteurHabilitationsPerimee = 0 Then GoTo SautPremierPave:
ZoneImpression.Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=NomPdfReconductionPerimee _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
'phrase ecrite en "A2"
If CompteurHabilitationsPerimee = 1 Then
QualificationsHabilitations2ansPerimee = "il y a " & CompteurHabilitationsPerimee & " Habilitation a reconduire par un organisme"
ElseIf CompteurHabilitationsPerimee > 1 Then
QualificationsHabilitations2ansPerimee = "il y a " & CompteurHabilitationsPerimee & " Habilitations a reconduire par un organisme"
End If
SautPremierPave:
'Enlevement filtres automatiques
With Worksheets("Feuille1")
If .FilterMode = True Then .ShowAllData
End With
End If
'programmation de la prochaine date de tache planifiee
Dim ReplaceValues As Variant
ReplaceValues = DateMiniReconduction
Dim FileName As String
Dim FSO As Object
Dim FindValues As Variant
Dim Text As String
Dim TextFile As Object
Dim Wks As Worksheet
'Remplacement date dans le fichier creation tache planifiee
FileName = CheminFichier & "\" & "AB_CreationTacheAlerteSuiviHabilitationsLigneDeCommandeBat.bat"
Set Wks = Worksheets("Feuil1")
FindValues = Date
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TextFile = FSO.OpenTextFile(FileName, 1, False)
Text = TextFile.ReadAll
TextFile.Close
Text = Replace(Text, FindValues, ReplaceValues)
Set TextFile = FSO.OpenTextFile(FileName, 2, False)
TextFile.Write Text
TextFile.Close
'Planification de la prochaine tache planifiee avec la commande Shell
Shell "cmd /c" & CheminFichier & "\" & "AB_CreationTacheAlerteSuiviHabilitationsLigneDeCommandeBat.bat"
Sheets("Feuille1").Select
Range("A10").Select
'Saut du deuximee Pave de commande s'il n'y a rien a envoyer
If CompteurHabilitationsPerimee = 0 Then GoTo SautDeuxiemePave:
'envoi par mail
Dim Phrase1 As String
Dim Phrase2 As String
Dim Phrase3 As String
Dim Phrase4 As String
Dim Phrase5 As String
Dim Phrase6 As String
Dim Phrase7 As String
Dim Phrase8 As String
Dim Phrase9 As String
Dim Phrase10 As String
Sheets("Signature_Mail").Visible = True
Sheets("Signature_Mail").Range("A2") = QualificationsHabilitations2ansPerimee
Sheets("Signature_Mail").Select
Phrase1 = Sheets("Signature_Mail").Range("A1")
Phrase2 = Sheets("Signature_Mail").Range("A2")
Phrase3 = Sheets("Signature_Mail").Range("A3")
Phrase4 = Sheets("Signature_Mail").Range("A4")
Phrase5 = Sheets("Signature_Mail").Range("A5")
Phrase6 = Sheets("Signature_Mail").Range("A6")
Phrase7 = Sheets("Signature_Mail").Range("A7")
Phrase8 = Sheets("Signature_Mail").Range("A8")
Phrase9 = Sheets("Signature_Mail").Range("A9")
Phrase10 = Sheets("Signature_Mail").Range("A10")
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim SigLogo As String
Dim NomSujet As String
NomSujet = "Reconduction Habilitations"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<p>" & Phrase1 & "<p>" & _
Phrase2 & "<br>" & _
Phrase3 & "<p>" & _
Phrase4 & "<br>" & _
Phrase5 & "<P>" & _
"<B>" & Phrase6 & "</B><br> " & _
Phrase7 & "<br> " & _
Phrase8 & "<br> " & _
Phrase9 & "<br>" & _
Phrase10 & "<br>"
' Langage HTML
'<p> saut d'une ligne
'<br> aller a la ligne
'<B> Police en Gras
On Error Resume Next
With OutMail
.To = Sheets("Signature_Mail").Range("A20").Value
.CC = Sheets("Signature_Mail").Range("A21").Value & ";" & Sheets("Signature_Mail").Range("A22").Value & ";" & Sheets("Signature_Mail").Range("A23").Value
.BCC = ""
.Subject = NomSujet
.HTMLBody = strbody & "<img src='" & CheminFichier & "\" & "logo.png'></img></html>" 'pour inserer un logo ou une image
'demande un accuse de reception
'.OriginatorDeliveryReportRequested = True
'demande un accuse de lecture
'.ReadReceiptRequested = True
.Attachments.Add NomPdfReconductionPerimee
.Send 'or use
'.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Sheets("Signature_Mail").Visible = False
SautDeuxiemePave:
ActiveWorkbook.Close SaveChanges:=False
End Sub |
mail automatique en fonction d'une date
Répondre avec citation
Partager