Set MonMessage = MaMessagerie.createitem(0)
MonMessage.Display
MonMessage.body = Contenu & MonMessage.body
Sub envoiMail() Dim Fichier As Variant Dim Signature As Variant Fichier = Application.GetOpenFilename("Feuilles de calcul,*.xlsm") MsgBox Fichier Dim MaMessagerie As Object Dim MonMessage As Object Set MaMessagerie = CreateObject("Outlook.Application") Set MonMessage = MaMessagerie.createitem(0) MonMessage.Display 'ce que tu m'as dis d'ajouter MonMessage.To = "bidule@bidule.fr" MonMessage.Cc = "" MonMessage.BCC = "" MonMessage.attachments.Add Fichier MonMessage.Subject = "Commandes" Contenu = "Bonjour Bidule," Contenu = Contenu & Chr(10) & Chr(13) Contenu = Contenu & "Ci-joint le fichier des commandes" Contenu = Contenu & Chr(10) & Chr(13) MonMessage.body = Contenu & MonMessage.body '"& MonMessage.body" = ce que tu m'as dis d'ajouter MonMessage.Send ReturnReceipt = True Set MaMessagerie = Nothing MsgBox "Votre mail a bien été envoyé." End Sub
MonMessage.Display 'ce que tu m'as dis d'ajouter
Sub Mail_Outlook_With_Signature_Html_1() ' Working in Office 2000-2016 Dim OutApp As Object Dim OutMail As Object Dim strbody As String Dim Fichier As String Dim Img As String, Plage As Range, secours As String Dim PathTmp As Variant Const cdoBasic = 1 Fichier = Application.GetOpenFilename("Feuilles de calcul,*.xlsm") 'répertoire temporaire PathTmp = Environ$("Temp") & "\" & "Image.jpg" Img = "Image.jpg" Set Plage = Sheets("Feuil1").Range("G17:M31") 'plage de cellule de ton logo If Dir(PathTmp) <> "" Then Kill PathTmp 'Création d'un fichier image dans le répertoire temporaire Plage.CopyPicture With ActiveSheet.ChartObjects.Add(0, 0, Plage.Width, Plage.Height) .Activate .Chart.Paste .Chart.Export PathTmp, "JPG" End With ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _ "Please visit this website to download the new version.<br>" & _ "Let me know if you have problems.<br>" & _ "<img src='cid:" & Img & "'" & "width='400' height='100'></font></span>" On Error Resume Next With OutMail .Display .To = "bidule@bidule.fr" .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = strbody & "<br>" & .HTMLBody .Attachments.Add PathTmp 'chemin image jointe .Attachments.Add Fichier 'chemin classeur .Send End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing Kill PathTmp 'on supprime le fichier image End Sub
Private Sub importimage() Image = Application.GetOpenFilename("Fichiers Gif ou Jpg ,*.gif;*.jpg") If Image = False Then Exit Sub a = Split(Image, "\") nomimage = a(UBound(a)) Set c = Sheets("Feuil1").Range("A1:B5") With ActiveSheet .Pictures.Insert(Image).Name = nomimage .Shapes(nomimage).Left = c.Left .Shapes(nomimage).Top = c.Top .Shapes(nomimage).LockAspectRatio = msoFalse .Shapes(nomimage).Height = c.Height .Shapes(nomimage).Width = c.Width End With End Sub
.Attachments.Add PathTmp 'chemin image jointe