2

I'm trying to use VBA to paste a selected range from Excel to Outlook. I want to keep it under the same conversation with all the recipients.

I have seen some codes: Outlook Reply or ReplyAll to an Email

I am stuck with this code (Application.ActiveExplorer.Selection).

Any ideas how to do this?

This is the code I have when creating a new email instead of replying:

Sub a()
Dim r As Range
Set r = Range("B1:AC42")
r.Copy

'Paste as picture in sheet and cut immediately
Dim p As Picture
Set p = ActiveSheet.Pictures.Paste
p.Cut



'Open a new mail item
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)

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

With outMail
.BodyFormat = olFormatHTML
  .Display
  '.HTMLBody = "write your email here" & "<br>" & .HTMLBody
  .Subject = ""
  .Attachments.Add ("path")


End With
'Paste picture
wordDoc.Range.Paste

For Each shp In wordDoc.InlineShapes
shp.ScaleHeight = 50 shp.ScaleWidth = 50
 Next

End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
Dennis
  • 23
  • 2

2 Answers2

1

EDIT:
I noticed that your question was edited by another user and now the mention of your need for the email to be a reply-all email is gone. This was probably in order to make your question simpler, but now my answer won't make as much sense. My answer also assumes that you also already have the HTML code needed to insert the email. If that's not the case, you might want to have a look at this gist to get you started on converting a range to HTML code.


The question you are linking to was on Outlook VBA so you have to make sure that you declare your variables differently since in Excel VBA, Application will refer to the Excel application and not Outlook.

Here's how you could go about this:

Sub ReplyAllWithTable()
    Dim outlookApp As Outlook.Application
    Set outlookApp = CreateObject("Outlook.Application")
    Dim olItem As Outlook.MailItem
    Dim olReply As MailItem ' ReplyAll

    Dim HtmlTable As String
    HtmlTable = "<table><tr><td>Test</td><td>123</td></tr><tr><td>123</td><td>test</td></tr></table>"

    For Each olItem In outlookApp.ActiveExplorer.Selection
    Set olReply = olItem.ReplyAll
    olReply.HTMLBody = "Here is the table: " & vbCrLf & HtmlTable & vbCrLf & olReply.HTMLBody
    olReply.Display

    'Uncomment next line when you're done with debugging
    'olReply.Send

    Next olItem
End Sub

About pasting range as a picture

If you take the approach in the code above, you won't be able to use the copy-paste method to insert your image. I personally prefer to set the HTML body of the email instead since it gives you more control. If you are ok with using the HTML method you could either:

  1. convert your range to HTML code and insert it inside the email (similarly as how it was done in the code above); or

  2. convert your range to an image, save it and insert it with HTML in the email body.

In order to achieve the 2nd option, you could run the following code:

Sub ReplyAllWithTableAsPicture()

    'REFERENCE:
    '- https://excel-macro.tutorialhorizon.com/excel-vba-send-mail-with-embedded-image-in-message-body-from-ms-outlook-using-excel/

    Dim outlookApp As Outlook.Application
    Set outlookApp = CreateObject("Outlook.Application")
    Dim olItem As Outlook.MailItem
    Dim olReply As MailItem ' ReplyAll


    Dim fileName As String
    Dim fileFullName As String
    fileFullName = Environ("temp") & "\Temp.jpg" 'CUSTOMIZABLE (make sure this file can be overwritten at will)
    fileName = Split(fileFullName, "\")(UBound(Split(fileFullName, "\")))

    RangeToImage fileFullName:=fileFullName, rng:=ActiveSheet.Range("B1:AC42") 'CUSTOMIZABLE (choose the range to save as picture)

    For Each olItem In outlookApp.ActiveExplorer.Selection 'if we have only one email, we could use: set olItem = outlookApp.ActiveExplorer.Selection(1)
    Set olReply = olItem.ReplyAll
    olReply.Attachments.Add fileFullName, olByValue, 0
    olReply.HTMLBody = "Here is the table: " & "<br>" & "<img src='cid:" & fileName & "'>" & vbCrLf & olReply.HTMLBody
    olReply.Display

    'Uncomment this line when you're done with debugging
    'olReply.Send

    Next olItem
End Sub

And add the following sub procedure in the module as well:

Sub RangeToImage(ByVal fileFullName As String, ByRef rng As Range)

    'REFERENCE:
    '- https://analystcave.com/excel-image-vba-save-range-workbook-image/

    Dim tmpChart As Chart, n As Long, shCount As Long, sht As Worksheet, sh As Shape
    Dim pic As Variant

    'Create temporary chart as canvas
    Set sht = rng.Worksheet
    rng.Copy
    sht.Pictures.Paste.Select
    Set sh = sht.Shapes(sht.Shapes.Count)
    Set tmpChart = Charts.Add
    tmpChart.ChartArea.Clear
    tmpChart.Name = "PicChart" & (Rnd() * 10000)
    Set tmpChart = tmpChart.Location(Where:=xlLocationAsObject, Name:=sht.Name)
    tmpChart.ChartArea.Width = sh.Width
    tmpChart.ChartArea.Height = sh.Height
    tmpChart.Parent.Border.LineStyle = 0

    'Paste range as image to chart
    sh.Copy
    tmpChart.ChartArea.Select
    tmpChart.Paste

    'Save chart image to file
    tmpChart.Export fileName:=fileFullName, FilterName:="jpg"

    'Clean up
    sht.Cells(1, 1).Activate
    sht.ChartObjects(sht.ChartObjects.Count).Delete
    sh.Delete

End Sub

Explanations:

In the ReplyAllWithTableAsPicture procedure, we are essentially doing the same thing as the first code, but we are now attaching an image to the email but keep it "hidden" so we can just include it in the body of the email without it being in the list of attachements when people receive the email. To include the image, we use the img tag with a source starting with "cid" allowing us to refer to the "hidden" attachment.

Since the image has to be a file, we use the RangeToImage procedure to generate the image file from the range that we supply. Currently, the file will be saved in the temporary directory always with the same name, which means that the file would be overwritten. Feel free to change the name or add the date to the name if you which to keep copies of these image files.

DecimalTurn
  • 3,243
  • 3
  • 16
  • 36
  • Your code works perfectly thank you very much! Any ideas how to keep past emails when sending this new one? It dissapears when i attach my picture file.Sorry i am new to VBA – Dennis Oct 17 '19 at 09:37
  • @Dennis I've added a new section at the bottom of my initial answer to address your issue regarding pasting as an image. – DecimalTurn Oct 17 '19 at 10:18
  • You're amazing everything works perfectly! Thank you very much for the help! – Dennis Oct 18 '19 at 02:36
1

Instead of creating mail item, Work with Selection item

Example outlookApp.ActiveExplorer.Selection(1)


Your code

Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)

'Get its Word editor
outMail.Display

Change to

Dim sel_Item As Outlook.MailItem
Set sel_Item = outlookApp.ActiveExplorer.Selection(1)    

Dim outMail As Outlook.MailItem
'Get its Word editor
Set outMail = sel_Item.ReplyAll
0m3r
  • 12,286
  • 15
  • 35
  • 71
  • Thank you for your answer! This is what i was technically looking for. Due to the change in the code shown as above there is when pasting my picture to outlook (Run-time error ' 4605': This command is not available.) any ideas how to fix this? – Dennis Oct 17 '19 at 08:53
  • Perhaps, you still need to `Display` the email before you can paste. – DecimalTurn Oct 17 '19 at 09:00
  • Pefect got it completely working! Any idea how to keep past conversations? As of now it only pulls all the email address from To: and CC: column but not pulling past emails when i paste my picture from excel. But it works without the the picture – Dennis Oct 17 '19 at 09:49