Sub EnvoyerMail(ByVal AdresseMail As String, ByVal Copie As String, ByVal ObjetMail As String, ByVal CorpsMail As String, ByVal AttachMail As String)
'il vaut mieux avoir ouvrir outlook au préalable
dossier = ThisWorkbook.Path
'Dans la barre de tache : outil/reference selectionner :Microsoft Outlook 11.0 library
'envoi de mail automatique
'initialisation des objets
' create new Outlook MailItem
Set objApp = CreateObject("Outlook.Application")
Set l_Msg = objApp.CreateItem(olMailItem)
' add graphic as attachment to Outlook message
' change path to graphic as needed
Set colAttach = l_Msg.Attachments
Set l_Attach = colAttach.Add(dossier & "\BDD_apres\Titre_mail.PNG")
l_Msg.Close olSave
strEntryID = l_Msg.EntryID
Set l_Msg = Nothing
' *** POSITION CRITICAL *** you must dereference the
' attachment objects before changing their properties
' via CDO
Set colAttach = Nothing
Set l_Attach = Nothing
' initialize CDO session
On Error Resume Next
Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False
' get the message created earlier
Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make
' it embedded and give it an ID for use in an <IMG> tag
Set oAttachs = oMsg.Attachments
Set oAttach = oAttachs.Item(1)
Set colFields = oAttach.Fields
Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
Set oField = colFields.Add(&H3712001E, "myident")
oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
oMsg.Update
' get the Outlook MailItem again
Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
' add HTML content -- the <IMG> tag
'l_Msg.HTMLBody = "<IMG align=baseline border=0 hspace=0 src=cid:myident>"
'l_Msg.Close (olSave)
'l_Msg.Display
'fin du test ajout image
'construction du mail
With l_Msg
.To = AdresseMail
.BCC = Copie '.BCC si on veut pas que sur le mail soit affiché les copies ou CC si on veut pas cacher
.Subject = ObjetMail
.HTMLBody = CorpsMail
.SentOnBehalfOfName = "MOI"
.Display
End With
'attente de 2 secondes le temps que tous les pcs aient le tps de réagir
Attendre (3)
'simulation d'appui des touches du clavier
SendKeys "%v", True
'réinitialisation des variables
Set objMail = Nothing
Set objOL = Nothing
End Sub
,
