Paste Excel range in Outlook

Question

I want to paste a range of cells in Outlook.

Here is my code:

Sub Mail_Selection_Range_Outlook_Body()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next
' Only send the visible cells in the selection.
Set rng = Selection.SpecialCells(xlCellTypeVisible)
Set rng = Sheets("Sheet1").RangeToHtml("D4:D12").SpecialCells(xlCellTypeVisible, xlTextValues)
On Error GoTo 0

If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

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

On Error Resume Next
With OutMail
    .To = ThisWorkbook.Sheets("Sheet2").Range("C1").Value
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line"
    .HTMLBody = RangeToHtml.rng
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    .Display
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

I am not getting any error, it just does not paste range in Outlook.

I have removed the On Error Resume Next. It gives me an error

Object doesn't support this property or method.

This `Set rng = Sheets("Sheet1").RangeToHtml("D4:D12").SpecialCells(xlCellTypeVisible, xlTextValues)` looks wrong. `RangeToHtml` (assuming that's the function from the MS website) returns a string, so you can't then call `SpecialCells` on that string. Get rid of that `On Error Resume Next` and you'll see the error. — Tim Williams, Sep 06 '13 at 17:30
Like @TimWilliams says remove `On Error Resume Next` unless you have a very specific reason to include it. — enderland, Sep 06 '13 at 17:51
Thank you for your reply Tim and Enderland, I have removed the On Error Resume Next, like you said and it gives me an error which is Object doesn't support this property or method. Do you have any work around to get rid the of that error? — Gilbert Jacob, Sep 06 '13 at 18:03

score 20 · Accepted Answer · answered Sep 08 '13 at 12:20

First off, RangeToHTML. The script calls it like a method, but it isn't. It's a popular function by MVP Ron de Bruin. Coincidentally, that links points to the exact source of the script you posted, before those few lines got b̶u̶t̶c̶h̶e̶r̶e̶d̶ modified.

On with Range.SpecialCells. This method operates on a range and returns only those cells that match the given criteria. In your case, you seem to be only interested in the visible text cells. Importantly, it operates on a Range, not on HTML text.

For completeness sake, I'll post a working version of the script below. I'd certainly advise to disregard it and revisit the excellent original by Ron the Bruin.

Sub Mail_Selection_Range_Outlook_Body()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
' Only send the visible cells in the selection.

Set rng = Sheets("Sheet1").Range("D4:D12").SpecialCells(xlCellTypeVisible)

If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

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


With OutMail
    .To = ThisWorkbook.Sheets("Sheet2").Range("C1").Value
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line"
    .HTMLBody = RangetoHTML(rng)
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    .Display
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Function RangetoHTML(rng As Range)
' By Ron de Bruin.
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

I have used your code for my requirement and its working fine, was wondering if I could add some Email body as well... like some text. I tried .HTMLBody="Hi, ..." & .HTMLBody=RangetoHTML(rng) but it didnt work. — Vinod, Jun 01 '15 at 10:04
@Vinod Were you able to add some additional text to the body of the email besides the one that was pasted by the macro? — synthaxe, Feb 13 '16 at 23:19
@synthaxe: you can get an idea how to add additional text to email body by following Ron the Bruin's post... Am not sure how to add image to email besides I now use java to send emails — Vinod, Feb 14 '16 at 06:23
I'd like to add that this method unfortunately doesn't copy color themes over as I found out, see [this question](https://stackoverflow.com/questions/37341797/copy-excel-theme-color-in-a-new-workbook/) for methods to keep the theme intact — JCKE, Feb 23 '19 at 02:11
why does .To have a value of `ThisWorkbook.Sheets("Sheet2").Range("C1").Value` — shadow2020, Aug 01 '19 at 15:36

score 6 · Answer 2 · answered Oct 22 '19 at 17:26

Often this question is asked in the context of Ron de Bruin's RangeToHTML function, which creates an HTML PublishObject from an Excel.Range, extracts that via FSO, and inserts the resulting stream HTML in to the email's HTMLBody. In doing so, this removes the default signature (the RangeToHTML function has a helper function GetBoiler which attempts to insert the default signature).

Unfortunately, the poorly-documented Application.CommandBars method is not available via Outlook:

wdDoc.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

It will raise a runtime 6158:

But we can still leverage the Word.Document which is accessible via the MailItem.GetInspector method, we can do something like this to copy & paste the selection from Excel to the Outlook email body, preserving your default signature (if there is one).

Dim rng as Range
Set rng = Range("A1:F10") 'Modify as needed

With OutMail
    .To = "xxxxx@xxxxx.com"
    .BCC = ""
    .Subject = "Subject"
    .Display
    Dim wdDoc As Object     '## Word.Document
    Dim wdRange As Object   '## Word.Range
    Set wdDoc = OutMail.GetInspector.WordEditor
    Set wdRange = wdDoc.Range(0, 0)
    wdRange.InsertAfter vbCrLf & vbCrLf
    'Copy the range in-place
    rng.Copy
    wdRange.Paste
End With

Note that in some cases this may not perfectly preserve the column widths or in some instances the row heights, and while it will also copy shapes and other objects in the Excel range, this may also cause some funky alignment issues, but for simple tables and Excel ranges, it is very good:

How can I add signature to it? I try standard ```.HTMLBody = myMailBody & .HTMLBody``` but can't see signature, do you know why? Maybe in this method it's not possible? — Muska, Sep 14 '20 at 14:37

Paste Excel range in Outlook

2 Answers2

Linked

Related