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
| Private Sub SendMail_Click()
Call SendMailAutomation
End Sub
Public Sub SendMailAutomation()
'Ajouter les références suivantes :
'Microsoft Outlook
'Microsoft DAO
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim strContenu As String
Dim oRst As DAO.Recordset
Dim oFld As DAO.Field
Dim strTo As String
'Instancie Outlook
Set oApp = CreateObject("Outlook.Application")
'Crée un nouveau message
Set oMail = oApp.CreateItem(olMailItem)
oMail.Body = "Bonjour," & vbCrLf & _
"Venez retrouver l'ensemble de nos produits sur notre site Web" & _
vbCrLf & "http://www.notresite.fr"
'Ouvre un recordset sur les clients
Set oRst = CurrentDb.OpenRecordset("SELECT * FROM PRESCRIPTEUR")
'Boucle sur chaque client et les ajoute au champ BCC du mail
While Not oRst.EOF
strTo = strTo & oRst.Fields("MAIL_PRESC") & "; "
oRst.MoveNext
Wend
'Supprime la dernière virgule
oMail.BCC = Left(strTo, Len(strTo) - 2)
oMail.Subject = "NewsLetter " & Date
'Envoi le mail
oMail.Send
'ferme le curseur
oRst.Close
Set oRst = Nothing
'Ferme Outlook
oApp.Quit
Set oApp = Nothing
End Sub |
Partager