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.
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 = "[email protected]"
.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:
Source: Stackoverflow.com