Picture pastes over text in Outlook mail using Exc

2019-09-07 06:58发布

I'm trying to copy a range in Excel as a picture to Outlook mail and add text in the body as well.

My code is adding the text and then pasting the picture on top of it. How can I get it to paste under the text?

Dim OutApp As Object
Dim outMail As Object
Dim myFileList(1) As String
Dim i As Long

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

Set RngCopied = Worksheets("Daily volume summary").Range("VolumeRange")

myFileList(0) = "Y:xyz\sales.pdf"
myFileList(1) = "Y:xyz\sales.xlsx"

'On Error Resume Next
With outMail
    .To = "abc@xyz.com"
    .CC = "def@xyz.com"
    .BCC = ""
    .Subject = "PBC Daily Sales  " & Format(Date, "mm/dd/yyyy")
    .Body = "Good morning," & vbNewLine & vbNewLine & "Attach is the Daily Sales report for  " & Format(Date, "dddd,mmmm,dd,YYYY") & "." & "<br>" 

    'Copy range of interest

    Dim r As Range

    Set r = Worksheets("Daily volume summary").Range("VolumeRange") 
    r.Copy

    'Get its Word editor 
    outMail.Display
    Dim wordDoc As Word.Document
    Set wordDoc = outMail.GetInspector.WordEditor

    'To paste as picture
    wordDoc.Range.PasteAndFormat wdChartPicture
    Dim shp As Object
    For Each shp In wordDoc.InlineShapes
        shp.ScaleHeight = 60
        shp.ScaleWidth = 60
    Next

    For i = 0 To UBound(myFileList)
        .Attachments.Add myFileList(i)
    Next

    .Send
End With
On Error GoTo 0

Set outMail = Nothing
Set OutApp = Nothing
End Sub

1条回答
我命由我不由天
2楼-- · 2019-09-07 07:25

In the line:

 wordDoc.Range.PasteAndFormat wdChartPicture

you are replacing the ENTIRE range of the message's word doc with your picture. Instead you need to note where in the range you want to paste this. This should put it after your text:

 wordDoc.Range(start:=wordDoc.Range.End - 2).PasteAndFormat wdChartPicture
查看更多
登录 后发表回答