excel-vba: Turn text from cells with particular format into an object suitable for outlook e-mail body, while maintaining the same format properties - vba

Question

My problem is the following:
I want to define a range, including cells in my spreadsheet that contain formatted text (bold font), and turn it into any object that I can later use as the body for an outlook e-mail.
One of the ways I have tried so far is via the RangetoHTML function by Ron de Bruin (http://www.rondebruin.nl/win/s1/outlook/bmail2.htm). However, the function brings the text cells into another excel workbook which finally yields a table in the outlook e-mail. I want to keep the very same format that I start with in my excel cells. That is, it must be lines of ordinary text and not a table-like body in the mail.
That's my current code:
Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Sheets("Preparation").Range("A90:A131")
With Selection
.Value = rng.Text
.Font.Bold = rng.Font.Bold
.Font.Color = rng.Font.Color
End With
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 = ""
.CC = ""
.BCC = ""
.Subject = ""
.HTMLBody = RangetoHTML(rng)
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Thanks in advance for your help

Answer 1

Ron de Bruin’s RangeToHtml shows how to use Excel’s PublishObjects to convert a worksheet range to Html that can be used as the body of an email. I am sure this has helped thousands of developers.
The difficulty that RdeB overcomes is that PublishObjects is designed to create and maintain webpages. His routine outputs to a file and then reads that file because that is the only way to get the Html string required for the email body.
The difficulty that RdeB cannot overcome is that PublishObjects create poor quality, proprietary CSS. By “poor quality”, I mean that there is a lot of unnecessary CSS and that row heights and column widths are defined in points to give sizes suitable for a PC. By “proprietary”, I mean it uses styles such as mso-ignore:padding and mso-number-format:General that only Microsoft browsers are guaranteed to understand. It appears the major browsers are able to cope but many people have found that some newer browsers cannot cope and display rubbish.
To demonstrate this and to test my code, I created a worksheet based on your image. Rows 16 to 18 are right-aligned because I have specified this. Rows 20 to 22 are right aligned because this is the Excel default for numeric, date and time values. Its appearance is:
You can use your real data.
Copy this code to your workbook:
Option Explicit
Sub Test1()
Dim PathCrnt As String
Dim PathFileCrnt As String
Dim RngStr As String
Dim WshtName As String
PathCrnt = ThisWorkbook.Path & "\" ' ## Output to the same folder as workbook holding the macro
PathFileCrnt = PathCrnt & "Test1.html" ' ## Change if you do not like my filename
WshtName = "Sheet1" ' ## Change to your worksheet
RngStr = "A1:A28" ' ## Change to your range
With ThisWorkbook
With .PublishObjects.Add(SourceType:=xlSourceRange, _
Filename:=PathFileCrnt, _
Sheet:=WshtName, _
Source:=RngStr, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
End With
End Sub
You will need to change some of the statements near the top marked with ##
Run this macro to output your range to the file.
On my laptop, Microsoft Edge, Microsoft Internet Explorer and Google Chrome all display the file and all look the same although IE and Chrome are slow to display. The column is down the centre of the window:
There are none of the background grey cells and wide, white border you showed. However, I have not tried to display it within Outlook.
Now look at the file with your favourite text editor. Notice how much CSS is repeated. Notice how many style start “mso-” indicating they are Microsoft extensions. Notice the heights and widths measured in “pt” (points). Some Html display engines can cope but some cannot.
I suspect that PublishObjects has not been maintained. It was available with Excel 2003 and perhaps earlier. Some of the old Microsoft CSS extensions now have standard CSS equivalents but PublishObjects has not been updated to use them.
I have my own RangeToHtml written entirely in VBA. It will handle all formatting except borders. My code is far too big to post on Stack Overflow so I have extracted the bits you need. You apparently need bold or not bold and left or right alignment. I do not know if you specify right alignment or if you have numeric fields which right align by default so I handle both.
My function ColToHtml(range) returns a complete Html file for the first column of a range. My code does not create a temporary workbook or a temporary file. It produces clean, crisp Html and Css. It produces a table because you cannot have right-alignment outside a table. However, with no borders, it is not obvious the output is a table. The only difference in appearance is that the table is left aligned. If you prefer a centred table, it would be an easy change.
This was my test routine:
Sub Test2()
Dim Rng As Range
With Worksheets("Sheet1")
Set Rng = .Range(.Cells(1, 1), .Cells(28, 1))
End With
Debug.Print ColumnToHtml(Rng)
End Sub
It outputs the Html string to the Immediate Window. I then copied it to a file. I could have used VBA to write to a file but this was easier. When I opened the file with Microsoft Edge, it looked the same. Have a look at this second file with your favourite text editor. Notice how much smaller it is. The PublishObjects version is 6,901 bytes while this second version is 1,681 bytes. Notice how only standard Css is used and that the minimum of Css is used. This allows the display engine to make its own decisions about how to display the file based on the type of output device.
My last test was:
Sub Test3()
' This will need a reference to Microsoft Outlook nn.0 Outlook library
' where nn is the number of the Outlook version you are using.
Dim Rng As Range
Dim OutApp As Outlook.Application
Dim MailItemNew As Outlook.MailItem
With Worksheets("Sheet1")
Set Rng = .Range(.Cells(1, 1), .Cells(28, 1))
End With
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set MailItemNew = OutApp.CreateItem(olMailItem)
With MailItemNew
.BodyFormat = olFormatHTML
.HTMLBody = ColumnToHtml(Rng)
.Display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set MailItemNew = Nothing
Set OutApp = Nothing
End Sub
This outputs the range to Outlook. I have used your code as a template but have referenced the Outlook library so I can use Outlook objects and constants. I had to reduce the font size to get it all on the screen at one time giving:
Again this has the same appearance except that the first letter of each line has been capitalized. I do not know how to stop the Outlook email editor doing this.
Incidentally, I selected the entire email and got the same appearance as in the image you posted.
The code for ColumnToHtml is below. Note that CellToHtml is the routine that actually creates the Html for a cell. It only handles bold and right alignment but it should be obvious that it would be easy to add other cell-level formats.
Function ColumnToHtml(ByRef RngCol As Range) As String
' Returns the first or only column of rng as a borderless table
' so it appears as a formatted list of rows.
Dim RngCell As Range
Dim RowCrnt As Long
Dim Table As String
' Build an Html table of the cells within the first column of RngCol
' ==================================================================
Table = Space(4) & "<table border=""0"">" & vbLf
For RowCrnt = RngCol.Row To RngCol.Row + RngCol.Rows.Count - 1
Set RngCell = RngCol.Worksheet.Cells(RowCrnt, RngCol.Column)
Table = Table & Space(6) & "<tr>" & CellToHtml(RngCell) & "</tr>" & vbLf
Next
Table = Table & Space(4) & "</table>"
' Build an Html file envelope around the table
' ============================================
ColumnToHtml = "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Frameset//EN""" & _
"""http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"">" & vbLf & _
"<html xmlns=""http://www.w3.org/1999/xhtml"" xml:lang=""en"" lang=""en"">" & vbLf & _
" <head></head>" & vbLf & _
" <meta http-equiv=""Content-Type""content=""text/html; charset=utf-8""/>" & vbLf & _
" <style>" & vbLf & _
" td.bold {font-weight:bold;}" & vbLf & _
" td.hAlign-right {text-align:right;}" & vbLf & _
" </style>" & vbLf & _
" </head>" & vbLf & _
" <body>" & vbLf & Table & vbLf & _
" </body>" & vbLf & _
"</html>"
End Function
Function CellToHtml(ByRef RngCell As Range) As String
' Convert a single cell to Html.
' This code handles: value, bold or not-bold (default) and left )default) or
' right-alignment.
' Note RngCell.Value is the value perhaps "1234" or "42999".
' and RngCell.Text is the display text perhaps "1,234" or "21-Sep-17".
' This is particularly important with dates and time where the
' value is unlikely to be what is displayed.
' Dates are held as days since 1-Jan-1900 and times are held as
' seconds-since-midnight / seconds-in-a-day. It is the NumberFormat that
' determine what you see.
Dim BoldCell As Boolean
Dim RAlignedCell As Boolean
Dim Style As String
Dim StyleNeeded As Boolean
CellToHtml = "<td"
' Add interior formatting here if required
If RngCell.Value = "" Then
' Ignore font and alignment formatting of empty cell.
Else
' Test for formats
BoldCell = False
RAlignedCell = False
Style = ""
StyleNeeded = False
If RngCell.Font.Bold Then
BoldCell = True
StyleNeeded = True
End If
If RngCell.HorizontalAlignment = xlRight Or _
(RngCell.HorizontalAlignment = xlGeneral And _
(IsNumeric(RngCell.Value) Or IsDate(RngCell.Value))) Then
RAlignedCell = True
StyleNeeded = True
End If
If StyleNeeded Then
CellToHtml = CellToHtml & " class="""
If BoldCell Then
If Style <> "" Then
Style = Style & " "
End If
Style = Style & "bold"
End If
If RAlignedCell Then
If Style <> "" Then
Style = Style & " "
End If
Style = Style & "hAlign-right"
End If
CellToHtml = CellToHtml & Style & """"
End If
End If
CellToHtml = CellToHtml & ">" ' Terminate "<td"
If RngCell.Value = "" Then
' Blank rows are displayed narrow. Use Non-blank space so display at homral width
CellToHtml = CellToHtml & " "
Else
CellToHtml = CellToHtml & RngCell.Text
End If
CellToHtml = CellToHtml & "</td>"
End Function
One last comment. You have not selected anything so I do not see the purpose of this code:
With Selection
.Value = rng.Text
.Font.Bold = rng.Font.Bold
.Font.Color = rng.Font.Color
End With