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

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 & "&nbsp;"
  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