如何通过visual basic将excel表中的图像粘贴到gmail正文中？ 方法 1：使用内嵌附件MIME 标准方法二：html中base64编码的二进制图像

编程问答 2022-05-30

问题描述

我在 excel 中写了一个宏，我通过 Gmail 发送邮件。我正在发送邮件，但无法发送图片，因为我无法在 Gmail 邮件正文中粘贴图片。我把我的代码。我也从activesheet（根据我的excel的Sheet4）获取图片。如何在我的邮件正文中添加这张图片？

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

解决方法

我在互联网上为您搜索并找到了两个选项。 它们都要求您使用文件系统上的文件， 邮件客户端（网络或应用程序）不支持第二个选项。

因此，您必须首先将工作表上的图像保存到文件系统中，如果它还没有的话。 可以在此处找到解决方案：Export pictures from excel file into jpg using VBA

方法 1：使用内嵌附件（MIME 标准）

添加到您的代码中（并调整您的 img 在 html 消息中的使用）：

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

方法二：html中base64编码的二进制图像

您需要添加对 Microsoft XML v6.0（或 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

感谢这些来源，我可以帮助您： https://stackoverflow.com/a/8134022/3090890 https://www.webdeveloper.com/d/173569-embed-images-in-cdo-mail-message/4

,

注意：base64 图像在 GMail 上不起作用 - 谷歌删除了这些数据（根据我构建自动电子邮件的经验）。我在类似情况下的解决方案是将附件上传到 AWS S3 等云服务，然后添加到 HTML 正文的链接，例如

<img src='https://my-email-attachments.s3.us-west-2.amazonaws.com/cats.png'>

另一种方法是将图像保存在系统本地 (Example code for saving an Excel shape to a file)，更新 HTML 模板以使其符合 MIME 标准（如 Method 1 by @Piemol 中所示）。

决定是附加还是链接，取决于您的业务需求，这实际上是另一个问题。

cdo.messageexcelexcelvba