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

Question

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

我在 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

Run Code Online (Sandbox Code Playgroud)

Answer 1

Pie*_*mol 2

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

因此，您必须首先将工作表上的图像保存到文件系统（如果尚不存在）。可以在这里找到解决方案：使用 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:\Users\Username\Desktop\test.png", "myimage.png", CdoReferenceTypeName)
Mail.Fields.Item("urn:schemas:mailheader:Content-ID") = "<myimage.png>"
Mail.Fields.Update

Run Code Online (Sandbox Code Playgroud)

方法2：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 /sf/answers/569381571/
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

Run Code Online (Sandbox Code Playgroud)

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

归档时间：	5 年，3 月前
查看次数：	564 次
最近记录：	5 年，3 月前