Menu
I wrote one macro in excel I m send mail via Gmail. I m sending message but I cannot send picture because I cannot paste picture in gmail message body . I put my code. Also I m getting picture from activesheet(Sheet4 according to my excel ). How can I add this picture in my mail message body ?
Sub SendGmail(frommail As String, password As String, tomail As String, subject As String, mesaj As String)
Dim pic As String
pic = CheckImageName
If pic <> "" Then
Sheet4.Shapes(pic).Copy
End If
If frommail <> "" And password <> "" And tomail <> "" And subject <> "" And mesaj <> "" Then
On Error Resume Next
'creating a CDO object
Dim Mail As CDO.message
Set Mail = New CDO.message
'Enable SSL Authentication
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
'Make SMTP authentication Enabled=true (1)
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'Set the SMTP server and port Details
'Get these details from the Settings Page of your Gmail Account
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
"smtp.gmail.com"
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Set your credentials of your Gmail Account
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = _
frommail
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = _
password
'Update the configuration fields
Mail.Configuration.Fields.Update
'Set All Email Properties
With Mail
.subject = subject
.From = frommail
.To = tomail
.CC = ""
.BCC = ""
.HTMLBody = mesaj
End With
'to send the mail
Mail.Send
If Err <> 0 Then
'MsgBox "Mail gönderme basarisiz.Eposta Ayarlari sayfasindan mail adresinizi ve sifrenizi kontrol ediniz!!!"
Call MessageBoxTimer("HATA", "Mail gönderme basarisiz.Eposta Ayarlari sayfasindan mail adresinizi ve sifrenizi kontrol ediniz!!!")
Exit Sub
End If
End If
End Sub
290
asked Oct 26 '22 15:10
I searched the internet for you and found two options. They both require you to use a file on the filesystem, the second option is not the best supported in mail clients (web or app).
So you'll have to save the image you have on your sheet to filesystem first, if it's not already there. A solution for that can be found here: Export pictures from excel file into jpg using VBA
Add to your code (and adjust the usage of your img in the html message):
Const CdoReferenceTypeName = 1
Mail.htmlBody = "<html>Check this out: <img src=""cid:myimage.png"" alt=""inline image test""/></html>"
Mail.MimeFormatted = True
Mail.Message.AddRelatedBodyPart("C:\Users\Username\Desktop\test.png", "myimage.png", CdoReferenceTypeName)
Mail.Fields.Item("urn:schemas:mailheader:Content-ID") = "<myimage.png>"
Mail.Fields.Update
You Need to add reference to Microsoft XML, v6.0 (or v3.0)
' Some data you'll need to build your htmlmessage:
Dim encodedImage As String
Dim htmlBody as String
encodedImage = EncodeFile("C:\Users\Username\Desktop\test.png")
' Example htmlBody, look at the img src !
htmlBody = "<html><head></head><body><p><img src=""data:image/png;base64," & encodedImage & """ alt=""base64 encoded image"" /></p></body></html>"
' Extra helper function to base64 encode binary files
' Thanks to https://stackoverflow.com/a/8134022/3090890
Public Function EncodeFile(strPicPath As String) As String
Const adTypeBinary = 1 ' Binary file is encoded
' Variables for encoding
Dim objXML
Dim objDocElem
' Variable for reading binary picture
Dim objStream
' Open data stream from picture
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open
objStream.LoadFromFile (strPicPath)
' Create XML Document object and root node
' that will contain the data
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
objDocElem.DataType = "bin.base64"
' Set binary value
objDocElem.nodeTypedValue = objStream.Read()
' Get base64 value
EncodeFile = objDocElem.Text
' Clean all
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing
End Function
Thanks to these sources I could help you out: https://stackoverflow.com/a/8134022/3090890 https://www.webdeveloper.com/d/173569-embed-images-in-cdo-mail-message/4
177
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
