通过excel发送包含嵌入图像的电子邮件

时间:2017-06-05 19:05:36

标签: excel vba excel-vba

我通过excel发送的电子邮件不会在接收端显示嵌入的图像。然而,嵌入的图像确实显示在我的最后。我的猜测是路径与我的桌面相关联。

如何显示图像?无法搞清楚问题。我的代码如下:

Sub EmailDailyFlow()
Dim mainWB As Workbook


Set otlApp = CreateObject("Outlook.Application")
Set olMail = otlApp.CreateItem(olMailItem)
Set mainWB = ActiveWorkbook


With olMail
    .To = "email@gmail.com"
    .Cc = ""
    .Subject = Format(Date - 1, "M.dd.yyyy") & " " & "MF & VIT Daily Fund Flow"
    .HTMLBody = "<html><body style='font-family: Times New Roman, Times, serif; font-size: 16px;'>" & _
            "<p>Please see below.</p>" & _
            "<p><u><b>Volatility:</u></b></p>" & _
            "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\MF.png'>" & _
            "<p><u><b>Muni:</u></b></p>" & _
            "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\MUNI.png'>" & _
            "<p><u><b>AFC:</u></b></p>" & _
            "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\AFC.png'>" & _
            "<p><u><b>AFT:</u></b></p>" & _
            "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\AFT.png'>" & _
            "<p><u><b>VIT:</u></b></p>" & _
            "<img src='C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\VIT.png'>" & _
            "<p>Thank you,</p>" & _
            "</body></html>"
.Send

End With
MsgBox ("Daily flow emails sent!")
End Sub`

2 个答案:

答案 0 :(得分:2)

试试这段代码。从一些网站长时间拍摄,但仍然像魅力一样工作 想法是以隐藏的方式附加图像,然后将其添加到使用HtmlBody中的图像名称。

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~
更新
我添加了另一个函数来检索图像的宽度和高度。我还更新了现有的sub以合并图像大小。

Sub EmailDailyFlow()
    Dim SendID
    Dim CCID
    Dim Subject
    Dim stdPic As StdPicture
    Dim imageSize As String

    Dim strPathImg1 As String
    Dim strFileImg1 As String
    Dim lngWidthImg1 As Long
    Dim lngHeightImg1 As Long

    Dim strPathImg2 As String
    Dim strFileImg2 As String
    Dim lngWidthImg2 As Long
    Dim lngHeightImg2 As Long

    Dim olMail As MailItem  'REQUIRES MICROSOFT OBJECT OUTLOOK LIBRARY REFERENCE

    strPathImg1 = "C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images"
    strFileImg1 = "MF.png"
    imageSize = GetImageSize(strPathImg1, strFileImg1)
    lngWidthImg1 = CLng(Split(imageSize, ":")(0))
    lngHeightImg1 = CLng(Split(imageSize, ":")(1))

    strPathImg2 = "C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images"
    strFileImg2 = "MUNI.png"
    imageSize = GetImageSize(strPathImg2, strFileImg2)
    lngWidthImg2 = CLng(Split(imageSize, ":")(0))
    lngHeightImg2 = CLng(Split(imageSize, ":")(1))

    Set otlApp = CreateObject("Outlook.Application")
    Set olMail = otlApp.CreateItem(olMailItem)

    SendID = "email@gmail.com"
    CCID = ""
    Subject = Format(Date - 1, "M.dd.yyyy") & " " & "MF & VIT Daily Fund Flow"

    With olMail
        .To = SendID
        If CCID <> "" Then
          .CC = CCID
        End If
        .Subject = Subject
        'ADD THE IMAGE IN HIDDEN MANNER, POSITION AT 0 WILL MAKE IT HIDDEN
        .Attachments.Add strPathImg1 & "\" & strFileImg1, olByValue, 0
        .Attachments.Add strPathImg2 & "\" & strFileImg2, olByValue, 0

        'NOW ADD IT TO THE HTML BODY USING IMAGE NAME
        'CHANGE THE SRC PROPERTY TO 'cid:your image filename'
        'IT WILL BE CHANGED TO THE CORRECT CID WHEN ITS SENT.
        .HTMLBody = "<html><body style='font-family: Times New Roman, Times, serif; font-size: 16px;'>" & _
                    "<p>Please see below.</p>" & _
                    "<p><u><b>Volatility:</u></b></p>" & _
                    "<img src='cid:" & strFileImg1 & "' width='" & lngWidthImg1 & "' height='" & lngHeightImg1 & "'>" & _
                    "<p><u><b>Muni:</u></b></p>" & _
                    "<img src='cid:" & strFileImg2 & "' width='" & lngWidthImg2 & "' height='" & lngHeightImg2 & "'>" & _
                    "<p><u><b>AFC:</u></b></p>" & _
                    "<p>Thank you,</p>" & _
                    "</body></html>"
        '.Display 'UNCOMMENT ME IF YOU WANT TO DISPLAY THE EMAIL
        .Send
    End With

    MsgBox ("Daily flow emails sent!")
End Sub

Function GetImageSize(filePath As String, fileName As String) As String
    'THIS WILL RETURN IMAGE SIZE IN "xyz:xyz" STRING FORMAT
    Dim strImageDimensions As String
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFile As Object

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace((filePath))
    Set objFile = objFolder.ParseName(fileName)

    strImageDimensions = objFile.ExtendedProperty("Dimensions")
    strImageDimensions = Replace(Mid(strImageDimensions, 2, Len(strImageDimensions) - 2), " x ", ":")
    GetImageSize = strImageDimensions

    Set objFile = Nothing: Set objFolder = Nothing: Set objShell = Nothing
End Function

答案 1 :(得分:0)

Sub EmailDailyFlow() Dim oApp As Outlook.Application Dim oEmail As MailItem Dim colAttach As Outlook.Attachments Dim oAttach1 As Outlook.Attachment Dim oAttach2 As Outlook.Attachment Dim oAttach3 As Outlook.Attachment Dim oAttach4 As Outlook.Attachment Dim oAttach5 As Outlook.Attachment Dim olkPA As Outlook.PropertyAccessor Const PR_ATTACH_CONTENT_ID="http://schemas.microsoft.com/mapi/proptag/0x3712001F"

Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(olMailItem)

Set colAttach = oEmail.Attachments
Set oAttach1 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\MF.png")
Set oAttach2 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\Muni.png")
Set oAttach3 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\AFC.png")
Set oAttach4 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\AFT.png")
Set oAttach5 = colAttach.Add("C:\Users\Name\Desktop\MF-VIT Daily Fund Flow\images\VIT.png")
Set olkPA1 = oAttach1.PropertyAccessor
Set olkPA2 = oAttach2.PropertyAccessor
Set olkPA3 = oAttach3.PropertyAccessor
Set olkPA4 = oAttach4.PropertyAccessor
Set olkPA5 = oAttach5.PropertyAccessor

olkPA1.SetProperty PR_ATTACH_CONTENT_ID, "MF.png"
olkPA2.SetProperty PR_ATTACH_CONTENT_ID, "MUNI.png"
olkPA3.SetProperty PR_ATTACH_CONTENT_ID, "AFC.png"
olkPA4.SetProperty PR_ATTACH_CONTENT_ID, "AFT.png"
olkPA5.SetProperty PR_ATTACH_CONTENT_ID, "VIT.png"

oEmail.Close olSave

oEmail.HTMLBody = "<body style='font-family: Times New Roman, Times, serif; font-size: 16px;'><p>Please see below.</p>" & _
                    "<img src='cid:MF.png'>" & _
                    "<p><u><b>Muni:</u></b></p>" & _
                    "<img src='cid:MUNI.png'>" & _
                    "<p><u><b>afcCore:</u></b></p>" & _
                    "<img src='cid:AFC.png'>" & _
                    "<p><u><b>aft:</u></b></p>" & _
                    "<img src='cid:AFT.png'>" & _
                    "<p><u><b>VIT:</u></b></p>" & _
                    "<img src='cid:VIT.png'>" & _
                    "<p>Thank you,</p>" & _

                    "</body>"

oEmail.Save
oEmail.To = "email@email.com"
oEmail.CC = ""
oEmail.Subject = Format(Date - 1, "M.dd.yyyy") & " " & "MF & VIT Daily Fund Flow"
oEmail.Send

Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing

End Sub