将签名和剪贴板图像添加到电子邮件正文VBA

时间:2017-02-15 18:26:35

标签: vba excel-vba excel

我试图通过VBA创建Outlook消息,我想在其中添加一串文本,一些表(使用RangetoHTML函数),一张图片,然后添加邮件签名。

我希望避免使用图片保存文件并通过附件添加(通常不会正确显示图像),即使用命令:

img src= 'img_name'.jpg

我希望可以使用以下代码完成,但到目前为止,我无法将图像放在文本之后和签名之前:

Sub Mail_Selection_Range_Outlook_Body()

    'Variables
    Dim r1 As Range
    Dim r2 As Range
    Dim s As String
    Dim wordDoc As Word.Document
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    'Get the text that will go on the mail body
    s = ActiveWorkbook.Sheets("Plan2").Range("A1")
    Set r1 = Sheets("Plan1").Range("A1:D4")

    With OutMail
        Set wordDoc = OutMail.GetInspector.WordEditor

        .To = "example@test.com"
        .Subject = "test"
        .HTMLbody = s & RangetoHTML(r1) & .HTMLbody

        'Set the range that will be pasted as an image
        Set r2 = Sheets("Plan1").Range("A5:D9")
        r2.CopyPicture Format:=xlPicture
        OutMail.Display

        'Set the position to paste the image
        wordDoc.Application.Selection.Start = currentPosition
        wordDoc.Application.Selection.End = wordDoc.Application.Selection.Start

        'Paste the image
        wordDoc.Application.Selection.Paste
        .Close olSave

    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub
  1. 如果我使用命令wordDoc.Application.Selection.Start = currentPosition,则图像会在文本之前;
  2. 如果我将命令.SendKeys "{END}"放在wordDoc.Application.Selection.Start = currentPosition;
  3. 之前,则相同
  4. 如果我使用wordDoc.Application.Selection.Start = Len(.Body),则会在签名后放置图像!
  5. 提前致谢。

1 个答案:

答案 0 :(得分:0)

我实际上只能通过对代码进行一些调整来找到解决方法:

Sub Mail_Selection_Range_Outlook_Body()

'Variables
Dim r1 As Range
Dim r2 As Range
Dim s1 As String
Dim s2 As String
Dim wordDoc As Word.Document
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'Get the text that will go on the mail body
s1 = ActiveWorkbook.Sheets("Plan2").Range("A1")
s2 = ActiveWorkbook.Sheets("Plan2").Range("A2")
Set r1 = Sheets("Plan1").Range("A1:D4")

With OutMail
    Set wordDoc = OutMail.GetInspector.WordEditor

    .To = "example@test.com"
    .Subject = "test"
    .HTMLbody = s1 & RangetoHTML(r1) & .HTMLbody

    'Set the range that will be pasted as an image
    Set r2 = Sheets("Plan1").Range("A5:J22")
    r2.CopyPicture Format:=xlPicture
    OutMail.Display

    'Set the position to paste the image
    wordDoc.Application.Selection.Start = currentPosition
    wordDoc.Application.Selection.End = wordDoc.Application.Selection.Start

    'Paste the image
    wordDoc.Application.Selection.Paste

    .HTMLbody = s2 & .HTMLbody

    .Close olSave

End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

这样我仍然可以避免通过附件粘贴图像。

注意:为了将图片后面的文本放在一个新行中,我只需在参考单元格内的文本之前添加"<br>"(在这种情况下,&#34; A1&#34; &#34; Plan2&#34;)。