Question

我正在编写一段代码，以将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

上面提到的Invitation.htm包含在发送电子邮件时不可见的图像。发送的电子邮件和接收的电子邮件中都没有。谁能建议一个更好的代码？我与VBA脱节，并且没有使用此代码。

非常感谢

Answer 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

在通过Outlook发送的Excel VBA应用程序生成的电子邮件中，将带有图像的HTML文件嵌入

1 个答案: