在Excel VBA生成的Outlook电子邮件中将带有图像的HTML文件嵌入 [英] Embedding an HTML file with images in an Outlook email generated by Excel VBA

问题描述

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

I want to send a personalized email generated by Excel VBA.

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

The email contains personalized text followed by a html file that contains images.

我尝试了以下代码，但未显示图像.

I tried the following code but the images are not displayed.

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

上面提到的Invitation.htm包含在发送电子邮件时不可见的图像.发送的电子邮件和接收的电子邮件中都没有.

The invite.htm referred above contains images which are not visible when the email is sent. Neither in the email messages sent nor in the email messages received.

推荐答案

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

Here ia an example that works for me you need to adapt it according to your needs. This will embed the image in the body of the email and will attach it from what I remember. Please note you need to display the email first and then send it that is the only way to show on different device, i learn that the hard way. It can be done via code as the below example if you want to display and review the email just comment out the .Send after you are happy you can press manually 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

这篇关于在Excel VBA生成的Outlook电子邮件中将带有图像的HTML文件嵌入的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！