Excel VBA отправить письмо с встроенным изображением - PullRequest
Новая
       5

Excel VBA отправить письмо с встроенным изображением

1 голос
/ 02 октября 2019

Я использовал приведенный ниже макрос для создания электронной почты со встроенным изображением, но он не работал, так как я продолжал получать

ошибка времени выполнения 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

Ответы [ 2 ]

1 голос
/ 09 октября 2019 
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
0 голосов
/ 02 октября 2019

Если вы используете позднюю привязку, то вы не можете использовать элементы Outlook OlBodyFormat enum.

olFormatHTML соответствует 2. 

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

Также - добавьте Option Explicit в начало вашего модуля и объявите все переменные.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...