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
| Private Sub but_mail_Click() 'envoi du mail du lundi
'déclaration des variable
Dim qry As DAO.QueryDef
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim sSQL As String
Dim sSQL1 As String
Dim destinataires As String
Dim copies As String
Dim Vdate_debut As Variant
Dim Vdate_fin As Variant
'assignation des données aux variables
Vdate_debut = txt_date_debut.Value
Vdate_fin = txt_date_fin.Value
Vnom_immo = txt_nom_immo.Value
Vprenom_immo = txt_prenom_immo.Value
Vmail_immo = txt_mail_immo.Value
Vn1_immo = txt_num1_immo.Value
Vn2_immo = txt_num2_immo.Value
Vn3_immo = txt_num3_immo.Value
Vnom_BCM = txt_nom_BCM.Value
Vprenom_BCM = txt_prenom_BCM.Value
Vmail_BCM = txt_mail_BCM.Value
Vn1_BCM = txt_num1_BCM.Value
Vn2_BCM = txt_num2_BCM.Value
Vn3_BCM = txt_num3_BCM.Value
Vcomment = txt_commentaire.Value
'requete de selection des destinataires
sSQL = "SELECT T_adresse_mail.mail" & _
" FROM T_adresse_mail" & _
" WHERE (T_adresse_mail.type_envoi = 'dest') AND T_adresse_mail.type_liste Like '*Plhebdo*';"
'requete de selection des copies
sSQL1 = "SELECT T_adresse_mail.mail" & _
" FROM T_adresse_mail" & _
" WHERE (T_adresse_mail.type_envoi = 'copie') AND T_adresse_mail.type_liste Like '*Plhebdo*';"
Set dbs = CurrentDb
'boucle venant alimenter la variable destinataires du résultat de la requete rst
' Exécute la requête
Set rst = CurrentDb.OpenRecordset(sSQL)
' Parcourez les enregistrements et concaténez les adresses e-mail en ajoutant un séparateur point virgule
Do While Not rst.EOF
destinataires = destinataires & rst("mail") & "; "
rst.MoveNext
Loop
'boucle venant alimenter la variable copies du résultat de la requete rst1
' Exécute la requête
Set rst1 = CurrentDb.OpenRecordset(sSQL1)
' Parcourez les enregistrements et concaténez les adresses e-mail en ajoutant un séparateur point virgule
Do While Not rst1.EOF
copies = copies & rst1("mail") & "; "
rst1.MoveNext
Loop
'Création du mail
Dim OutApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Recipient
Dim Recipients As Recipients
Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(olMailItem)
'destinataire
Set Recipients = objOutlookMsg.Recipients
Set objOutlookRecip = Recipients.Add(destinataires) 'mails des destinataires
'copie
objOutlookMsg.CC = (copies) 'mails des copies
objOutlookRecip.Type = 1
'expéditeur
objOutlookMsg.SentOnBehalfOfName = "toto@toto.com" ' insertion de l'adresse expéditrice
'niveau d'importance
objOutlookMsg.Importance = olImportanceHigh
'objet du mail
objOutlookMsg.Subject = " Planning d'astreinte de la semaine du : " & Vdate_debut & " au " & Vdate_fin & "." ' objet avec intégration des éléments"
'création du corps de texte
'<!--Création du mail du lundi-->
Dim s As String, oCol As New Collection, v
With oCol
.Add "<font color=#0000FF> Bonjour,</font><br>"
.Add "<br>"
.Add "<br>"
.Add "<br>"
.Add "<font color=#0000FF> Veuillez trouver, ci-dessous, le planning d'astreinte du <b >" & Vdate_debut & " au " & Vdate_fin & " <b /> (jusqu'à 8h00). </font> <br />"
.Add "<br>"
.Add "<font color=#0000FF> Merci de bien vouloir nous confirmer la bonne prise en compte de ces informations. </font> <br />"
.Add "<br>"
'insertion du tableau
.Add "<table border=""1"">"
.Add "<tr>"
.Add "<th bgcolor=#000099> <font color=#FFFFFF>Périmètres</font></th>"
.Add "<th bgcolor=#000099> <font color=#FFFFFF>Filière Immobilière<br /><font size=""2"">(sigle du service)</font></th>"
.Add "<th bgcolor=#000099> <font color=#FFFFFF>Correspondant Alerte - Continuité d'activité<br /><font size=""2"">(sigle du service)</font></th>"
.Add "</tr>"
.Add "<tr>"
.Add "<td bgcolor=#99ccff> <font color=#004C99> <b > A contacter en cas de <b /> </font></td>"
.Add "<td><font color=#004C99>Demande d'accès aux locaux<br /><font size=""4"">Incidents d'exploitation immobilière</font></td>"
.Add "<td><font color=#004C99>Incidents majeurs IT <br />Autres incidents majeurs de continuité d'activité <br /> (indisponibilité d'immeuble, incendie, inondation,<br /> panne électrique majeure) </font></td>"
.Add "</tr>"
.Add "<tr>"
.Add "<td bgcolor=#99ccff> <font color=#004C99> <b > Correspondant<b /> <font color=#FF0000>* </font></td>"
.Add "<td><font color=#990000>" & Vnom_immo & " " & Vprenom_immo & " <br />Astreinte à partir du: " & Vdate_debut & " </font></td>"
.Add "<td><font color=#009900>" & Vnom_BCM & " " & Vprenom_BCM & "<br /> </font></td>"
.Add "</tr>"
.Add "<tr>"
.Add "<td bgcolor=#99ccff> <font color=#004C99> <b > Téléphone<b /> <font color=#FF0000>* </font></td>"
.Add "<td><font color=#990000>Num # 1: " & Vn1_immo & "<br />Num # 2: " & Vn2_immo & "<br /> Num # 3: " & Vn3_immo & "<br /></font></td>"
.Add "<td><font color=#009900>Num # 1: " & Vn1_BCM & "<br />Num # 2: " & Vn2_BCM & "<br /> Num # 3: " & Vn3_BCM & "<br /></font></td>"
.Add "</tr>"
.Add "<tr>"
.Add "<td bgcolor=#99ccff> <font color=#004C99> <b > Procédure <b /> </font></td>"
.Add "<td><font color=#004C99>Contacter le correspondant au numéro #1<br />Si pas de réponse : le contacter aux numéros #2 et #3<br />"
.Add "Réessayer pendant 15 minutes alternativement <br /> aux 3 numéros<br /></td>"
.Add "<td><font color=#004C99>Contacter le correspondant au numéro #1<br />Si pas de réponse : le contacter aux numéros #2 et #3<br />"
.Add "Réessayer pendant 15 minutes alternativement <br /> aux différents numéros<br /></td>"
.Add "</tr>"
.Add "<tr>"
.Add "<td bgcolor=#99ccff> <font color=#004C99> <b > BU/SU couvertes <b /> </font></td>"
.Add "<td><font color=#004C99>liste des directions couvertes ,<br /> et DIR(Paris et Lyon)<br /></td>"
.Add "<td><font color=#004C99>liste des directions couvertes ,<br /> et DIR (Paris et Lyon)<br />"
.Add "<font color=#990000>Ainsi que ROCK<br /></td>"
.Add "</tr>"
.Add "</table>"
.Add ""
'met la ligne ci-dessous en rouge
.Add "<FONT color=#FF0000> *Dans le cadre du RGPD, merci de bien vouloir vous assurer que le mail contenant ces informations sera supprimé lorsque la période d'astreinte concernée sera terminée.</FONT><br>"
.Add "<br>"
.Add "<br>"
.Add "<br>"
.Add "Bien cordialement<br>"
.Add "<br>"
.Add "Service Astreinte<br>"
'met la ligne ci-dessous en rouge
.Add "<FONT color=#FF0000> XX XX XX XX XX </FONT><br>"
.Add "Sureté<br>"
.Add "Tour X<br>"
.Add "<br>"
'insertion du logo
.Add "<img alt= ""logoODM"" align=baseline src= ""C:\Images\ODM.bmp"" >"
.Add "<br>"
End With
s = ""
For Each v In oCol
s = s & v & vbNewLine
Next
objOutlookMsg.HTMLBody = s
'objOutlookMsg.Send ' envoi le mai directement sans prévisuel
objOutlookMsg.Display ' ouvre le mail avant envoi
Set OutApp = Nothing
'Fermeture et libération des variables objet
rst.Close
rst1.Close
Set rst = Nothing
Set rst1 = Nothing
Set dbs = Nothing
End Sub |
Création d'un mail avec tableau HTML avec alimentation des destinataires et coipes par requetes
Répondre avec citation
Partager