在 Excel VBA 生成的 Outlook 电子邮件中嵌入带有图像的 HTML 文件答案

【问题标题】：Embedding an HTML file with images in an Outlook email generated by Excel VBA在 Excel VBA 生成的 Outlook 电子邮件中嵌入带有图像的 HTML 文件
【发布时间】：2019-05-01 19:05:44
【问题描述】：

我想发送一封由 Excel VBA 生成的个性化电子邮件。

电子邮件包含个性化文本，后跟包含图像的 html 文件。

我尝试了以下代码，但没有显示图像。

Sub Mail_Outlook_With_Html_Doc()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim oFSO As Object
    Dim oFS As Object
    Dim sText As String            

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFS = oFSO.OpenTextFile("C:\....\invite.htm")

    Do Until oFS.AtEndOfStream
        sText = oFS.ReadAll()
    Loop

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    'strbody = personalized email body generated here

    On Error Resume Next

    With OutMail
        .display
        .To = ToAdd
        .CC = 
        .BCC = ""
        .Subject = "Test Email"
        .ReadReceiptRequested = True

        ' the html file is appended here to the personalized email body generated
        .HTMLBody = strbody & sText
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

上面提到的invite.htm 包含发送电子邮件时不可见的图像。既不在发送的电子邮件中，也不在收到的电子邮件中。

【问题讨论】：

我认为您的 .htm 文件可能存在问题。图片是本地参考吗？我逐字记录了您的代码并设置了 .HTMLBody = "" 并且加载图像没有问题。它还使用通用字符串代替 strBody 和 HTML sn-p 代替 sText。
.html 文件中有多个图像。还有一些文本被格式化成两列的表格。这有什么改变吗？

标签： html excel vba image outlook

【解决方案1】：

这是一个对我有用的示例，您需要根据需要对其进行调整。这会将图像嵌入到电子邮件的正文中，并根据我的记忆附上它。请注意，您需要先显示电子邮件然后发送它，这是在不同设备上显示的唯一方法，我学到了很难的方法。如果您想显示和查看电子邮件，可以通过以下示例代码完成，只需在您满意后注释掉.Send，您可以手动按下send。

Option Explicit
Dim titleName As String
Dim firstName As String
Dim lastName As String
Dim fullName As String
Dim clientEmail As String
Dim ccEmail As String
Dim bccEmail As String
Dim emailMessage As String

Sub GenerateInfo()

    Dim WS As Worksheet
    Dim lrow As Long
    Dim cRow As Long

    Set WS = ActiveSheet

    With WS
        lrow = .Range("E" & .Rows.Count).End(xlUp).Row
        Application.ScreenUpdating = False
        For cRow = 2 To lrow
            If Not .Range("L" & cRow).value = "" Then
                titleName = .Range("D" & cRow).value
                firstName = .Range("E" & cRow).value
                lastName = .Range("F" & cRow).value
                fullName = firstName & " " & lastName
                clientEmail = .Range("L" & cRow).value

                Call SendEmail

                .Range("Y" & cRow).value = "Yes"
                .Range("Y" & cRow).Font.Color = vbGreen

            Else
                .Range("Y" & cRow).value = "No"
                .Range("Y" & cRow).Font.Color = vbRed
            End If
        Next cRow
    End With

    Application.ScreenUpdating = True

    MsgBox "Process completed!", vbInformation

End Sub
Sub SendEmail()

    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim sigString As String
    Dim Signature As String
    Dim insertPhoto As String
    Dim photoSize As String

    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)

    'Change only Mysig.htm to the name of your signature
    sigString = Environ("appdata") & _
                "\Microsoft\Signatures\Marius.htm"

    If Dir(sigString) <> "" Then
        Signature = GetBoiler(sigString)
    Else
        Signature = ""
    End If

    insertPhoto = "C:\Users\marius\Desktop\Presale.jpg" 'Picture path
    photoSize = "<img src=""cid:Presale.jpg""height=400 width=400>" 'Change image name here

    emailMessage = "<BODY style=font-size:11pt;font-family:Calibri>Dear " & titleName & " " & fullName & "," & _
                    "<p>I hope my email will find you very well." & _
                    "<p>Our <strong>sales preview</strong> starts on Thursday the 22nd until Sunday the 25th of November." & _
                    "<p>I look forward to welcoming you into the store to shop on preview.<p>" & _
                    "<p> It really is the perfect opportunity to get some fabulous pieces for the fast approaching festive season." & _
                    "<p>Please feel free to contact me and book an appointment." & _
                    "<p>I look forward to seeing you then." & _
                    "<p>" & photoSize & _
                    "<p>Kind Regards," & _
                    "<br>" & _
                    "<br><strong>Marius</strong>" & _
                    "<br>Assistant Store Manager" & _
                    "<p>"


    With outlookMail
        .To = clientEmail
        .CC = ""
        .BCC = ""
        .Subject = "PRIVATE SALE"
        .BodyFormat = 2
        .Attachments.Add insertPhoto, 1, 0
        .HTMLBody = emailMessage & Signature 'Including photo insert and signature
        '.HTMLBody = emailMessage & Signature 'Only signature
        .Importance = 2
        .ReadReceiptRequested = True
        .Display
        .Send

    End With

    Set outlookApp = Nothing
    Set outlookMail = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String

    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

【讨论】：

.html 文件中有多个图像。还有一些文本被格式化成两列的表格。这有什么改变吗？
是的，您需要根据您的特定需求对其进行调整。在“调用 SendEmail”之前声明另一个全局变量以将表复制到循环中。取决于您的 excel 文件究竟需要如何调整登录 ex 也许该表位于不同的工作表中，而不是将其放入 for 循环中没有意义，您需要另一种方法来做到这一点，也许另一个循环通过第二张表或者，如果您只有一张表需要发送给所有人，则无需将其放入循环中，只需在该表上设置范围，您就可以在 sendEmail 中调用该变量。
关于包含多个图像的 .html 文件，我不确定您的确切意思。如果 .html 就像是多个图像的容器，并且您希望将它们显示在电子邮件的正文中，那将无法正常工作。您需要在文件夹中有单独的图像并具有良好的命名约定 ex Img1 并执行 for 循环并每次增加 I 取决于您要添加多少 img 或者如果您有 10 个 img 的简单方法为每个声明 10 个变量img 和你在我的代码 photoSize 中看到的将它替换为你的，你需要在两者之间使用 '&' 并且一切顺利。
如果 .html 就像一个包含多个图像的容器，并且您希望将它们显示在“电子邮件正文”中 - 是的。这就是问题所在。然后有附加到图像的超链接。循环很复杂。我正在考虑将其制作为 .mht 文件。但不确定代码是否有效。我们需要 GetFile 中的二进制模式阅读器。我猜它不能作为文本流打开。 ——
可能是这个问题中的解决方案将起作用stackoverflow.com/questions/35609112/… 但是如何将word文档中的复制内容放在使用excel字段中的一些变量生成的自定义电子邮件内容下方。