Paste in Outlook an excel range - excel

Question

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

Answer 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:
convert your range to HTML code and insert it inside the email (similarly as how it was done in the code above); or
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.

Answer 2

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