Option Explicit
Sub SendEmail()
Dim rng As Range, OutApp As Object, OutMail As Object
Dim sCC As String, sSubj As String, sEmAdd As String
Dim objCombinedR As Range
'// Change the values of these variables to suit
sEmAdd = "abc@abc.com"
sCC = ""
sSubj = "My Subject"
Set rng = Nothing
On Error Resume Next
Sheets("Sheet1").Range("Q2:Y4") = Sheets("Sheet1").Range("B18:F20").Value
Sheets("Sheet1").Range("Q7:V17") = Sheets("Sheet1").Range("B2:G13").Value
Set rng = Sheets("Sheet1").Range("Q2:V17")
rng.AutoFit
On Error GoTo 0
With Application
.EnableEvents = 0
.ScreenUpdating = 0
.Calculation = xlCalculationManual
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = sEmAdd
.CC = sCC
.Subject = sSubj
.HTMLBody = "<p>Dear Name:" & "<br><br>" & _
"Please see attached for your review.." & "<br><br>" & _
RangetoHTML(rng) & "<br><br>" & _
"Regards," & "<br><br>" & _
"Finance</p>"
'.Send '// Change this to .Display if you want to view the email before sending.
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = 1
.Calculation = xlCalculationAutomatic
End With
Sheets("Sheet1").Range("Q2:V17").Value = ""
Set OutMail = Nothing: Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object, ts As Object, TempWB As Workbook, TempFile As String
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
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 xlPasteColumnWidths, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With
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
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=")
TempWB.Close 0
Kill TempFile
Set ts = Nothing: Set fso = Nothing: Set TempWB = Nothing
End Function
