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
|
Dim appOutlook As Outlook.Application
Set appOutlook = Outlook.Application
Dim MESSAGE As Outlook.MailItem
Dim objRecipient As Outlook.Recipient
Set MESSAGE = appOutlook.CreateItem(olMailItem)
With MESSAGE
.Subject = "[Création] " & ActiveCell.Value
' Corps en HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<html><body> <font face=""calibri""><p>Bonjour,</p><p>Test.</p>"
' Destinataire principal
Set objRecipient = .Recipients.Add("ABC@free.fr")
objRecipient.Type = olTo 'olBCC, olCC, olOriginator ou olTo.
objRecipient.Resolve
' Destinataire en copie
Set objRecipient = .Recipients.Add(Variable_contact)
objRecipient.Type = olCC 'olBCC, olCC, olOriginator ou olTo.
objRecipient.Resolve
'
'Ajout d 'une PJ
Dim PJ
PJ = Rep_Projet & "\[Création] " & ActiveCell.Value & ".xlsx"
'on verifie d'abord qu'elle existe.
If Dir(PJ) <> "" Then
.Attachments.Add PJ
End If
'ajout AR lecture
.ReadReceiptRequested = False
'Afficher le mail
.Display
'Envoyer le mail automatiquement
'.Send
End With |
Partager