CODEWITHSUNDEEP
excelvbaoutlookrangecopy-paste
CG_30
CG_30

Reputation: 11

Picture pastes over text in Outlook mail using Excel VBA

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 = "[email protected]"
    .CC = "[email protected]"
    .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

Upvotes: 1

Views: 3708

Answers (1)

OpiesDad
OpiesDad

Reputation: 3435

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

Upvotes: 5

Related Questions