Question

我使用下面的宏来创建带有嵌入式图片的电子邮件，但是由于我不断收到

，它无法正常工作

运行时错误5“无效的过程调用或参数”

并突出显示了此代码.BodyFormat = olFormatHTML。

Sub Outlook_Email_With_Inline_Image()
    'Add reference to Microsoft Outlook Object Library
    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    'Dim OutApp As Outlook.Application
    'Dim oOutlookEmail As Outlook.MailItem

    'Create New Outlook Email Item to Attach Image(s)
    Set OutApp = CreateObject("Outlook.Application")
    Set oOutlookEmail = OutApp.CreateItem(0)

    'Actual Excel VBA to send email with Embedded images
    With oOutlookEmail
        .To = "user@gmail.com"
        .CC = ""
        .BCC = ""
        .Subject = "Congrats"
        .BodyFormat = olFormatHTML
        .Attachments.Add "C:\Users\Username\Pictures\Michael's Email Promotion\Angela.jpg", olByValue, 0
        sImgName = "ImageFile.img"
        .HTMLBody = "<img src='cid:" & sImgName & "'" & " ><br>" 'Mention only the image file name not its path
        'Or Use this below line.
        '.HTMLBody = "<img src='" & sImgName & "'" & " ><br>"
        .Display
    '    .Send 'or just put .Display to check
    End With

    Set OutlookMail = Nothing
    Set OutApp = Nothing
End Sub

Answer 1

Sub email()

Dim aOutlook As Object
Dim aEmail As Object
Dim obj As Object
Dim olInsp As Object
Dim myDoc As Object
Dim oRng As Object

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(olMailItem)
Dim ToCc As Range, strBody, strSig As String
Dim fColorBlue, fColorGreen, fColorRed, fDukeBlue1, fDukeBlue2, fAggieMaroon, fAggieGray As String
Dim Greeting, emailContent As String
Dim emailOpen, emailSig As String



For Each ToCc In ActiveSheet.[A2:A2]


'=============================================================

Dim ToEmail, CcEmail, ToNm, CcNm As String
Dim DescrDt, DescrID, DescrNm As String

    ToNm = Cells(ToCc.Row, [C1].Column).Value
    CcNm = Cells(ToCc.Row, [G1].Column).Value
    ToEmail = Cells(ToCc.Row, [E1].Column).Value
    CcEmail = Cells(ToCc.Row, [I1].Column).Value

    DescrID = Cells(ToCc.Row, [B1].Column).Value
    DescrNm = Cells(ToCc.Row, [D1].Column).Value
    DescrDt = "20190426"



'=============================================================
'''determine strBody --email message

Dim strFontSize, strFontName, strFontColor As String
    strFontName = "Arial"
    strFontColor = fAggieGray
    strFontSize = 13


Greeting = "<BODY style=" & Chr(34) & "font-family:" & strFontName & "; font-size:" & strFontSize & Chr(34) & ">" & _
            "<span style=""color:" & strFontColor & """>" & _
    Application.WorksheetFunction.Proper(ToNm) & "," & "<br> <br>" & _
            "</span style=""color:" & strFontColor & """>" & "</BODY>"



emailSig = "<BODY style=" & Chr(34) & "font-family:" & strFontName & "; font-size:" & strFontSize & Chr(34) & ">" & _
            "<span style=""color:" & strFontColor & """>" & _
    "<br> <br>" & "- OE & HRIS Team" & "<br>" & "______________________" & "<br> <br>" & _
            "</span style=""color:" & strFontColor & """>" & "</BODY>" & _
            "<BODY style=" & Chr(34) & "font-family:" & strFontName & "; font-size: 10px;"">" & _
            "<span style=""color:" & strFontColor & """>" & _
    "[Email generated through Excel Macros and Google meme download - source data: October 3, 2019]" & _
            "</span style=""color:" & strFontColor & """>" & "</BODY>"



Set colAttach = oEmail.Attachments
Set oAttach1 = colAttach.Add("C:\Users\AA.jpg")
Set oAttach2 = colAttach.Add("C:\Users\BB.png")
Set oAttach3 = colAttach.Add("C:\Users\CC.jpg")
Set oAttach4 = colAttach.Add("C:\Users\DD.gif")
Set oAttach5 = colAttach.Add("C:\Users\EE.png")
Set oAttach6 = colAttach.Add("C:\Users\FF.jpg")
Set oAttach7 = colAttach.Add("C:\Users\GG.jpg")

Set olkPA1 = oAttach1.PropertyAccessor
Set olkPA2 = oAttach2.PropertyAccessor
Set olkPA3 = oAttach3.PropertyAccessor
Set olkPA4 = oAttach4.PropertyAccessor
Set olkPA5 = oAttach5.PropertyAccessor
Set olkPA6 = oAttach6.PropertyAccessor
Set olkPA7 = oAttach7.PropertyAccessor



olkPA1.SetProperty PR_ATTACH_CONTENT_ID, "AA.jpg"
olkPA2.SetProperty PR_ATTACH_CONTENT_ID, "BB.png"
olkPA3.SetProperty PR_ATTACH_CONTENT_ID, "CC.jpg"
olkPA4.SetProperty PR_ATTACH_CONTENT_ID, "DD.gif"
olkPA5.SetProperty PR_ATTACH_CONTENT_ID, "EE.png"
olkPA6.SetProperty PR_ATTACH_CONTENT_ID, "FF.jpg"
olkPA7.SetProperty PR_ATTACH_CONTENT_ID, "GG.jpg"


oEmail.Close olSave



oEmail.HTMLBody = Greeting & "<BODY style=" & Chr(34) & "font-family:" & strFontName & "; font-size:" & strFontSize & Chr(34) & ">" & _
            "<span style=""color:" & strFontColor & """>" & _
    "<br> <br>" & _
                    "<img src=""cid:FF.jpg""height=520 width=750>" & _
                    "<br> <br>" & "<img src=""cid:AA.jpg""height=520 width=750>" & _
                    "<br> <br>" & "<img src=""cid:BB.png""height=520 width=750>" & _
                    "<br> <br>" & "<img src=""cid:DD.gif""height=520 width=750>" & _
                    "<br> <br>" & "<img src=""cid:GG.jpg""height=520 width=750>" & _
                    "<br> <br>" & "<img src=""cid:EE.png""height=520 width=750>" & _
                    "</body>"

oEmail.Save
oEmail.To = "MM@email.com"
oEmail.CC = "AA@email.com"

oEmail.Subject = "Congrats " & Application.WorksheetFunction.Proper(ToNm) & Chr(32) & Application.WorksheetFunction.Proper(DescrNm)
oEmail.display
'oEmail.send



NEXT_ToCC:
    Set aEmail = Nothing
    Set olInsp = Nothing
    Set myDoc = Nothing
    Set oRng = Nothing
Next ToCc

'oEmail.Send

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


End Sub

Answer 2

如果您使用的是后期绑定，则不能使用Outlook OlBodyFormat枚举的成员。

olFormatHTML对应于2。

Sub Outlook_Email_With_Inline_Image()
    Const olFormatHTML As Long = 2
    ...
    .BodyFormat = olFormatHTML
    ...
End Sub

也-在模块顶部添加Option Explicit并声明 all 变量。

Excel VBA发送带有嵌入图像的电子邮件

2 个答案: