2

I already made this code, I want to send a image already exist inside the Excel (called Picture 1810) by e-mail. But I cant discovery how to do the .Body.

Anyone can help me?

Sub CreateMail()    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngCC As Range
    Dim rngSubject As Range
    Dim rngBody As Shape
    Dim rngAttach As Range

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With ActiveSheet
        Set rngTo = .Range("f2")
        Set rngCC = .Range("f3")
        Set rngSubject = .Range("c2")
        Set rngBody = .Shapes("Picture 1810")
    End With

    With objMail
        .To = rngTo.Value
        .CC = rngCC.Value
        .Subject = rngSubject.Value
        .Body = rnbbody
        .Send
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngSubject = Nothing
    Set rngBody = Nothing
    Set rngAttach = Nothing
End Sub
Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
  • Possible duplicate of [Embed picture in outlook mail body excel vba](https://stackoverflow.com/questions/44869790/embed-picture-in-outlook-mail-body-excel-vba) – dwirony Mar 14 '19 at 17:34
  • I don't want to embed a range of cell like a image, I already have a image, I want to range the shape or object and past on the e-mail – Armando Cerdeira Mar 14 '19 at 17:39
  • You will have to export the shape as an image to a folder and then embed it as shown in the above link – Siddharth Rout Mar 14 '19 at 18:07
  • To export the Shape, you can either put it in a Chart Object and export as shown [HERE](https://stackoverflow.com/questions/11939087/export-chart-as-image-with-click-of-a-button) or use the Stephen Bullen's PastePicture Function as shown [HERE](https://stackoverflow.com/questions/10782394/pop-up-the-excel-statusbar/10787496#10787496) – Siddharth Rout Mar 14 '19 at 18:12

1 Answers1

0

By this you retain your standard email signature and paste the shape either floating over the body text or like a character in between:

With objMail
    .To = rngTo.Value
    .CC = rngCC.Value
    .Subject = rngSubject.Value
    .Display
    Dim wdDoc As Word.Document
    Set wdDoc = .GetInspector.WordEditor
    If Not wdDoc Is Nothing Then
        With wdDoc.Range
            .Collapse wdCollapseStart
            .InsertBefore "Hi there," & vbCrLf & "here's my shape:" & vbCrLf
            .Collapse wdCollapseEnd
            .InsertAfter vbCrLf & "Best wishes," & vbCrLf
            .Collapse wdCollapseStart

            ActiveSheet.Shapes("Picture 1810").Copy
            '.Paste ' over the text
            .PasteAndFormat wdChartPicture ' within text
        End With
        Set wdDoc = Nothing
    End If
    '.Send
End With
Asger
  • 3,822
  • 3
  • 12
  • 37