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
| Private Sub envoimail_Click()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim adresse As String
Dim message As String
Dim sujet As String
Dim MesParution As String
Dim strHTML As String
Dim i As Byte, j As Byte
Dim ListeEmail As dao.Recordset
Dim ListeParution As dao.Recordset
'requête pour récupérer les publications de la table EnvoiMail
Set ListeParution = CurrentDb.OpenRecordset("SELECT DISTINCT Envoimail.PUBLICATION FROM Envoimail;")
'boucle pour récupérer les adresses et les publications de la table EnvoiMail
With ListeParution
For j = 0 To .RecordCount - 1
MesParution = !PUBLICATION
Set ListeEmail = CurrentDb.OpenRecordset("SELECT Envoimail.NOM, Envoimail.PRENOM, Envoimail.PUBLICATION, Envoimail.Date, Envoimail.COURRIEL, Envoimail.ENVOI" & _
" FROM Envoimail" & _
" WHERE (((Envoimail.PUBLICATION)=" & Chr(34) & MesParution & Chr(34) & ")) AND (((Envoimail.ENVOI)=No));")
sujet = "Renouvellement de votre abonnement " & MesParution 'le sujet est le même pour tous les mails
With ListeEmail
'.MoveFirst
For i = 1 To .RecordCount
If Not IsEmpty(!COURRIEL) Then
adresse = !COURRIEL
message = !PUBLICATION
Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.CreateItem(0)
strHTML = "<!DOCTYPE HTML pUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & _
"<HTML><HEAD>" & _
"<META http-equiv=Content-Type content=""text/html; charset=iso-8859-1"">" & _
"<META content=""MSHTML 6.00.2800.1516"" name=GENERATOR></HEAD>" & _
"<BODY><DIV STYLE=""font-size: 16px; font_face: Tahoma;"">"
With OutlookMail
.Subject = sujet
.To = adresse
'Corps du message
.HTMLBody = strHTML & "<IMG SRC=""C:\Documents and Settings\P.Ouellet\Bureau\mail\titre.png"">" & _
"<TABLE>" & _
"<TBODY>" & _
"<TR>" & _
"<TH>" & _
"<TH width=150>C'est plus de 265 publications à des prix imbattables mais aussi des <B>certificats cadeaux</B> accompagnés d'une carte de souhaits pour un anniversaire, la fête des mères, la fête des pères, Noël ou toute autre occasion." & _
"<br><br>Pour plus de renseignements, n'hésitez pas à nous contacter.<BR>Nos téléphonistes sont prêts à vous aider du lundi au vendredi de 9h à 17h." & _
"</TH>" & _
"<TH widht=426><br><br><B>Bonjour, votre abonnement de " & MesParution & " arrive à écheance sous peu.*</B>" & _
"<br><br> Afin de ne manquer aucune copie de votre publication préférée et pour continuer de profiter de nos bas prix, nous vous suggérons de visiter dès maintenant notre site web ou de communiquer avec notre service à la clientèle." & _
"<br><br> <B>Profitez de nos tarifs réduits sur plus de 265 titres de journaux et magazines, tous offerts avec notre garantie que ce sont les plus bas prix sur le marché.</B>" & _
"</TH>" & _
"</TR>" & _
"</TBODY>" & _
"</TABLE>" & _
"<BR><BR>" & _
"<B>* Si vous avez renouvelé vos abonnements dernièrement, veuillez ne pas tenir compte de cet avis.</B>" & _
"<BR><BR>On prend au sérieux votre vie privée. Vous avez reçu ce message parce que vous êtes abonné par l'entremise de notre service et qu'il se peut qu'un de vos abonnements expire prochainement." & _
"<BR>Pour ne plus recevoir de message vous avisant de la fin prochaine d'un de vos abonnements, veuillez communiquer avec notre service à la clientèle. Merci !<BR>" & _
"</DIV>" & _
"</BODY>" & _
"</HTML>"
.Send 'on envoie le mail créé
End With
adresse = ""
message = ""
End If
.MoveNext
Next i 'on passe au mail suivant
End With
.MoveNext
Next j
End With
ListeParution.Close
Set ListeParution = Nothing
ListeEmail.Close
Set ListeEmail = Nothing
End Sub |
Publipostage personnalisé par mail
Répondre avec citation
.
Envoyé par ambact
Partager