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
| Private Sub Outlook_Click()
Dim MonOutlook As New Outlook.Application
Dim MonMessage As Outlook.MailItem
Dim ListeEMail As Recordset
Dim ListeComplete As String
' Initialisation
Set MonMessage = MonOutlook.CreateItem(0)
Set ListeEMail = CurrentDb.OpenRecordset("SELECT e-mail FROM demandes 2007")
'Set oRst = CurrentDb.OpenRecordset("SELECT * FROM demandes 2007")
ListeEMail.MoveFirst
ListeComplete = ""
' Parcourt des enregistrements de la requête
While Not ListeEMail.EOF
ListeComplete = ListeComplete & ListeEMail("e-Mail") & ";"
MonMessage.Attachments.Add ListeEMail(" ")
ListeEMail.MoveNext
Wend
'Remplissage de l'objet MailItem
MonMessage.To = e - mail
MonMessage.BCC = Left(ListeComplete, Len(ListeComplete) - 1) ' On enlève le dernier point virgule
MonMessage.Subject = Id
MonMessage.Body = prenom & vbCrLf
' Envoi du mail
MonMessage.Display
' Fermeture de la session Outlook et désallocation des objets
MonOutlook.Quit
ListeEMail.Close
Set MonOutlook = Nothing
Set ListeEMail = Nothing
End Sub |
Partager