如何通过visual basic将图像从excel表粘贴到gmail正文中?



我在excel中写了一个宏,我通过Gmail发送邮件。我正在发送邮件,但是无法发送图片,因为我无法在gmail邮件正文中粘贴图片。我写了代码。我也从活动表(Sheet4根据我的excel)得到图片。如何在邮件正文中添加图片?

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

我在网上搜索了你,找到了两个选项。它们都要求您在文件系统上使用一个文件,第二个选项在邮件客户端(web或app)中不是最好的支持。

因此,如果工作表上的图像还没有保存到文件系统中,那么您必须首先将它保存到文件系统中。一个解决方案可以在这里找到:使用VBA将图片从excel文件导出为jpg文件

方法1:使用内联附件(MIME标准)添加到您的代码中(并调整html消息中img的使用):

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:UsersUsernameDesktoptest.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:UsersUsernameDesktoptest.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/3090890https://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'>

另一种方法是将图像保存在本地系统上(例如将Excel形状保存到文件的示例代码),更新HTML模板使其符合MIME标准(如方法1中所示@Piemol)

决定是附加还是链接,取决于你的业务需要,这真的是另一个问题。

最新更新