如何在Outlook邮件中插入不同范围的多个图像

时间:2019-03-29 17:10:59

标签: excel vba

我设法用给定范围的图像创建了一个Outlook邮件。 但是,尝试插入2张不同范围的图像会导致其中一张图像正确显示,而另一张则导致“图片无法显示”

这是我到目前为止所拥有的。

Sub test()

Dim OApp As Object
Dim OMail As Object
Dim signature As String
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
'------------------------------------------------------------------
'MAIL BODY
'------------------------------------------------------------------
Dim mailBody As String
mailBody = _
  "<font size=3 font face=calibri color=black>Dear All,<br><br>" _
& "<font size=3 font face=calibri color=black>BLABLABLA.<br><br>"
'------------------------------------------------------------------
'CREATE MAIL IN OUTLOOK
'------------------------------------------------------------------
With OMail
    .To = "TEST@GMAIL.COM"
    .CC = ""
    .BCC = ""
    .Subject = "SUBJECT"
    .Display
    signature = .HTMLBody
    '------------------------------------------------------------------
    'IMAGE OF SELECTION [TOOLS/REFERENCES/MICROSOFT WORD OBJECT LIBRARY]
    '------------------------------------------------------------------
    Dim wdDoc As Word.Document
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set olApp = CreateObject("Outlook.Application")
    Set wdDoc = OMail.GetInspector.WordEditor
    wdDoc.Range.PasteAndFormat Type:=wdChartPicture
    With wdDoc
        .InlineShapes(1).Height = 170
    End With

    First = .HTMLBody
    '------------------------------------------------------------------
    'IMAGE OF SELECTION [TOOLS/REFERENCES/MICROSOFT WORD OBJECT LIBRARY]
    '------------------------------------------------------------------
    Sheets("X").Range("B2:CW132").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set olApp = CreateObject("Outlook.Application")
    Set wdDoc = OMail.GetInspector.WordEditor
    wdDoc.Range.PasteAndFormat Type:=wdChartPicture
    With wdDoc
        .InlineShapes(1).Height = 370
    End With
    '------------------------------------------------------------------
    .HTMLBody = mailBody & vbNewLine & First & .HTMLBody & signature

End With
End Sub

0 个答案:

没有答案