How to paste excel data table into outlook through vba - vba

Question

Private Sub CommandButton23_Click()
Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With ActiveSheet
Set rngTo = Sheets("Helpdesk Data").Range("D4")
Set rngSubject = Sheets("Helpdesk Data").Range("I5")
'Set rngBody = Sheets("Helpdesk Data").Range("D4")
'Set rngAttach = .Range("B4")
End With
Sheets("Helpdesk Data").Select
Sheets("Helpdesk Data").Range("B12:Z12").Select
Sheets("Helpdesk Data").Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Now I want to paste above copied data from "Helpdesk data" into Outlook Body, but don't know how to do it.. I tried Specialpaste with Outlook object but it also dispays errors..
With objMail
'.To = rngTo.Value
.Subject = "Owner Issue at Site " & rngSubject.Value & " - (" & rngTo.Value & " Circle)"
.Body = "Sir, " & _
"Please find below site issue reported Today."
'.Attachments.Add rngAttach.Value
.Display
End With
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing
End Sub
So anyone could tell me just how could i paste my B12 to Z12 data from "Helpdesk data" sheet to outlook body..

Answer 1

One method is to use the .HTMLBody property and to turn the required range into HTML formatting.
In your e-mail sub, with your objMail, include the .HTMLBody property and pass a range into the rngHTML function.
.HTMLBody = "Table below." & vbNewLine & rngHTML(Range("A1:B10"))
Include the function which will generate the HTML range in your code.
Function rngHTML(Rng As Range)
Dim fso As Object, ts As Object, TempWB As Workbook
Dim TempFile As String
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'' copy the range and create a new workbook to paste the data into
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 rngHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
rngHTML = ts.readall
ts.Close
rngHTML = Replace(rngHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
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
Please see Ron de Bruin's website, this is where I originally came across this function; he also explains another method of getting a range into the body of an e-mail.
Hope this helps.