Roll Your Own HTML from Excel VBA

You probably know that you can save an Excel workbook in HTML format. I do it for my golf league and it works fine. It also generates a pig of an HTML file, mainly because Microsoft is trying to have high fidelity (make it look the same in the browser as it does in the desktop).

For my most recent sports-related project, I just didn’t want such a large file. I run an NFL survivor pool. You can read all the rules if you like, but basically each participant selects one NFL team per week. If that team wins, the participant survives. If they lose, they’re done. Whoever is left at the end is the winner. I needed a quick and easy way to update the results on a web page.

I start with this spreadsheet:

Bold teams means a loss. Italicized teams are winners. Unformatted teams means they haven’t played yet (or I haven’t updated yet). The end result is this:

I found a bunch of images of NFL helmets and a free green checkmark image on the interwebs. Now all I have to do is read the data and convert it to HTML. Here’s the code:

Sub MakeHmtl()

Dim rRow As Range
Dim rCell As Range
Dim sHtml As String
Dim sBody As String
Dim sTable As String
Dim sRow As String
Dim bLoss As Boolean
Dim lFnum As Long
Dim sFname As String

Const sPAIDIMG As String = ""

'header
sHtml = Tag("DK Survivor Pool", "title") & vbNewLine
sHtml = sHtml & ""
sHtml = Tag(sHtml, "head", , True) & vbNewLine

'body
sBody = Tag("DK Survivor Pool", "h1") & vbNewLine
sBody = sBody & Tag("Updated: " & Format(Now, "yyyy-mmm-dd hh:mm AM/PM"), "p") & vbNewLine
sBody = sBody & Tag(Tag("Rules", "a", "href = ""survivorrules.html"""), "p") & vbNewLine

'table
For Each rRow In Sheet1.Range("A2:S13").Rows
bLoss = False
For Each rCell In rRow.Cells
If rCell.Column = 1 Or rCell.Row = 2 Then
sRow = sRow & AddClass(Tag(rCell.Value, "td"), "name")
ElseIf rCell.Column = 2 Then
If IsEmpty(rCell.Value) Then
sRow = sRow & Tag("", "td")
Else
sRow = sRow & Tag(sPAIDIMG, "td")
End If
Else
Select Case True
Case rCell.Font.Bold
sRow = sRow & AddClass(Tag(MakeImage(rCell.Value), "td"), "loss")
bLoss = True
Case rCell.Font.Italic
sRow = sRow & AddClass(Tag(MakeImage(rCell.Value), "td"), "win")
Case IsEmpty(rCell.Value)
If bLoss Then
sRow = sRow & AddClass(Tag("", "td"), "loss")
Else
sRow = sRow & Tag("", "td")
End If
Case Else
sRow = sRow & Tag(MakeImage(rCell.Value), "td")
End Select
End If
Next rCell
sTable = sTable & Tag(sRow, "tr") & vbNewLine
sRow = """"
Next rRow

sBody = sBody & Tag(sTable, "table", "border=""1"" cellpadding=""5""", True)
sHtml = sHtml & Tag(sBody, "body", , True)
sHtml = Tag(sHtml, "html", , True)

If Len(Dir("C:Test_Datadebug.ini")) = 0 Then
sFname = "C: UsersdickDropboxSportsSurvivorindex.html"""
Else
sFname = "C:UsersdickMy DocumentsMy DropboxSportsSurvivorindex.html"""
End If

lFnum = FreeFile
Open sFname For Output As lFnum
Print #lFnum, sHtml
Close lFnum

End Sub

Creating text files from scratch can be a pain in the butt, but HTML files are worse. You have to get all those tags right and properly closed. I hate unindented HTML, so there’s more work there too. Generally I try to work from the inside out on HTML files. That way I can a pass a couple of arguments into a function to make the tags and be assured that I don’t miss something. Take the header section for example. First I pass “DK Survivor Pool” and “title” into the Tag function. That function looks like this:

Function Tag(sValue As String, sTag As String, Optional sAttr As String = "", Optional bIndent As Boolean = False) As String

Dim sReturn As String

If Len(sAttr) > 0 Then
sAttr = Space(1) & sAttr
End If

If bIndent Then
sValue = vbTab & Replace(sValue, vbNewLine, vbNewLine & vbTab)
sReturn = "< " & sTag & sAttr & ">" & vbNewLine & sValue & vbNewLine & "< /" & sTag & ">"
Else
sReturn = "< " & sTag & sAttr & ">" & sValue & "< /" & sTag & ">"
End If

Tag = sReturn

End Function

(WordPress doesn’t like HTML so there’s an extra space in the closing tag part.) I get back something that looks like this

DK Survivor Pool

Next, I append the link tag manually because it doesn’t really fit into my inside-out dynamic. Finally, I call sHtml = Tag(sHtml, "head", , True) & vbNewLine to wrap what I have in a head tag. I also set the optional Indent argument to true and get this:


DK Survivor Pool

The code wraps whatever I send it, in whatever tag I send it, and indents along the way. The other optional argument is for including attributes within the tag. I want my table tag to have border=”1″ and cellpadding=”5″ so I supply those to the function when needed. I use the class attribute a lot to format winners and losers. I created a separate function to add a class attribute so I wouldn’t have to type it in the code.

Function AddClass(sTag As String, sClass As String) As String

AddClass = Replace(sTag, ">", " class=""" & sClass & """>", 1, 1)

End Function

The last helper function is to create an image tag. My Tag function is good for enclosing something in opening and closing tags. The image tag is self-closing, so it gets its own home. On the spreadsheet, I record the team name so that it matches the image file name. If I type “eagles” for a Philadelphia pick, the MakeImage function returns

Function MakeImage(sValue As String) As String

MakeImage = ""

End Function

The main code basically loops through all the cells, determines the HTML necessary, and appends it to one long string. That string is then written to a file. Once complete, I manually FTP that file up to my web server. A couple of other notes on the code:

Losing teams are colored red and that participant doesn’t get to select any more. I wanted all the succeeding weeks to be red also. I use the bLoss variable to handle this. When I get to a loss, I set bLoss to True. When an empty cell is detected (no selection yet), I add the “loss” class to the td tag to color it red.

The last part is the location of the file. My dropbox folder is in two different places on two different computers. I’m not sure why this is, but I think it relates to which operating system was installed when I installed Dropbox. Back in the Windows XP days, Dropbox put it in My DocumentsMy Dropbox and in Windows 7, it’s directly under the user folder and they dropped the “My”. At least I think that’s what happened. To differentiate the two, I found a file that I’m absolutely sure is on one computer and absolutely sure isn’t on the other. I use Len(Dir(..)) to test the existence of the file and change the path accordingly. I think we both know this will break some time in the future, but it works for now.

One of the downsides to the inside-out approach for concatenating HTML is code readability. If I’m just building a string one character at a time, it’s pretty easy to follow along. When I use functions to wrap strings in tags, it’s a little harder. You might expect that the html opening tag would be near the top of the procedure, but it’s actually the last tag I add because it’s “outside”.

Finally, if you’re new to creating big strings in VBA, you should note that to embed a double quote into a string, you use two double quotes in succession.

11 thoughts on “Roll Your Own HTML from Excel VBA

  1. Don’t know if you considered the use of a XML library or not.

    Since HTML is a type of XML, how about using the MSXML library to generate the document? For examples search Google (or Bing if you prefer) for ‘vba create xml’ (you know what to do with the quotes {grin}). One example, albeit simplistic, is at http://www.freevbcode.com/ShowCode.asp?ID=1919

    I imagine a realistic solution will probably be recursive. An example of reading a XML document is at http://msdn.microsoft.com/en-us/library/aa468547.aspx

  2. I agree, the use of XML for the data, and an XSLT stylesheet and MSXML to reformat the data into a HTML file, will greatly reduce these lines of code to <20 lines.

  3. That would be pretty neat to see a comparison done with XML vs the way Kusleika did it. I don’t think I’ll spend the time on it though, so if anyone does it, let me know so I can see what the comparison would be.

  4. The code below uses the MS XML library to convert a worksheet into a HTML document. It includes the capability of adding images in place of cell values. Functionally, it is along the lines of the original post though it is missing some elements. However, it includes enough capabilities that it should be easily adaptable to the original task.

    Option Explicit
    ‘To pretty print see http://msdn.microsoft.com/en-us/library/ms753769.aspx

    ‘Pre-requisite is a reference to Microsoft XML

    Sub setAttributes(Obj As IXMLDOMElement, ParamArray AttrList())
        Dim I As Integer
        For I = LBound(AttrList) To UBound(AttrList) Step 2
            Obj.setAttribute AttrList(I), AttrList(I + 1)
            Next I
        End Sub
    Sub createDoc()
        Dim aDoc As MSXML2.DOMDocument: Set aDoc = New MSXML2.DOMDocument
        aDoc.preserveWhiteSpace = True

        Dim RootELe As MSXML2.IXMLDOMElement: Set RootELe = aDoc.createElement(“html”)
        aDoc.appendChild RootELe
       
        Dim HeadEle As IXMLDOMElement
        Set HeadEle = RootELe.appendChild(aDoc.createElement(“head”))
       
        Dim StyleLink As IXMLDOMElement
        Set StyleLink = HeadEle.appendChild(aDoc.createElement(“link”))
        setAttributes StyleLink, “rel”, “stylesheet”, “type”, “text/css”, “href”, “my_style.css”

        Dim BodyEle As IXMLDOMElement: Set BodyEle = RootELe.appendChild(aDoc.createElement(“body”))
       
        Dim TableEle As IXMLDOMElement
        Set TableEle = BodyEle.appendChild(aDoc.createElement(“table”))
        Dim I As Long
        With ActiveSheet.UsedRange
        For I = 1 To .Rows.Count
            Dim RowEle As IXMLDOMElement
            Set RowEle = TableEle.appendChild(aDoc.createElement(“tr”))
            Dim J As Long
            For J = 1 To .Columns.Count
                Dim CellEle As IXMLDOMElement
                Set CellEle = RowEle.appendChild(aDoc.createElement(“td”))
                With .Cells(I, J)
                If IsEmpty(.Value) Then
                    CellEle.Text = ” “
                Else
                    Dim ImgEle As IXMLDOMElement
                    Set ImgEle = aDoc.createElement(“img”)
                    setAttributes ImgEle, “src”, .Value & “left.bmp”, “alt”, .Value
                    CellEle.appendChild ImgEle
                    End If
                If .Font.Bold Then CellEle.setAttribute “class”, “loss”
                If .Font.Italic Then CellEle.setAttribute “class”, “win”
                    End With
                Next J
            Next I
            End With
        aDoc.Save “c: empxmltest.htm”
        End Sub

  5. “One of the downsides to the inside-out approach for concatenating HTML is code readability. If I’m just building a string one character at a time, it’s pretty easy to follow along. When I use functions to wrap strings in tags, it’s a little harder. You might expect that the html opening tag would be near the top of the procedure, but it’s actually the last tag I add because it’s “outside”.”

    In addition to the MSXML approach, here’s another way of doing this from the ‘top to the bottom.’ Use a stack to save the ending tags and when ready pop the stack.

    The below if a functional example.

    Option Explicit
    ‘Should put the stack stuff in a class!
    Dim Stack() As String, TopOfStack As Integer
    Sub initStack()
        ReDim Stack(9)
        TopOfStack = LBound(Stack) – 1
        End Sub
    Sub pushStack(Item)
        If TopOfStack = UBound(Stack) Then _
            ReDim Preserve Stack(UBound(Stack) + 10)
        TopOfStack = TopOfStack + 1
        Stack(TopOfStack) = Item
        End Sub
    Function popStack()
        popStack = Stack(TopOfStack)
        TopOfStack = TopOfStack – 1
        End Function
    Sub addTag(ByRef Rslt As String, Tag As String)
        Rslt = Rslt & “<“ & Tag & “>”
        pushStack “</” & Tag & “>”
        End Sub
    Sub doStuff()
        Dim Rslt As String
        initStack
        addTag Rslt, “html”
            addTag Rslt, “head”
                Rslt = Rslt & “<!– This is a comment within the head tag –>”
                Rslt = Rslt & popStack()
            addTag Rslt, “body”
                addTag Rslt, “p”
                    Rslt = Rslt & “Hello there”
                    Rslt = Rslt & popStack()
                Rslt = Rslt & popStack()
            Rslt = Rslt & popStack()
        Debug.Print Rslt
        End Sub
  6. Depending on how the initial raw data is stored in the workbook, using XML and XSLT Stylesheets within VBA would produce more elegant results.

    Create a table in a worksheet and map it to an XML Schema .xsd file from the “Source” button on the XML section on the developer tab. The data can then be exported to an xml file as below. Use the MS Excel XML Toolbox to create and assign a Schema file to the set of data to be exported. – http://www.microsoft.com/download/en/details.aspx?id=21031

    John
    12.5

    Anne
    48.2

    Steven
    58.4

    Create an XSLT stylesheet, with a name of formatTable.xsl, as below. The stylesheet will loop thru the data in the xml file and format as a simple html table with a conditional check on the data stored in the Value element and format with appropriate colour.

    body * {font-family:Verdana;font-size:8pt}
    th {background:#525252;color:#f2f2f2;text-align:left}
    td {border-bottom:1px solid #999}
    td.red {background:red}
    td.green {background:yellowgreen}

    Name
    Value

    Insert a new module into the workbook and use the VBA procedure below

    Option Explicit

    Public Sub sbConvertData()
    ‘Pre-requisite is a reference to Microsoft XML 6.0
    Dim oXML As New MSXML2.DOMDocument30
    Dim oXSL As New MSXML2.DOMDocument30

    Dim sXML As String
    Dim sDataFile As String
    Dim sStylesheetFile As String
    Dim sResultFile As String

    Dim bLoaded As Boolean

    ThisWorkbook.XmlMaps(1).Export ThisWorkbook.Path & Application.PathSeparator & “data.xml”, True
    sDataFile = ThisWorkbook.Path & Application.PathSeparator & “data.xml”
    sStylesheetFile = ThisWorkbook.Path & Application.PathSeparator & “formatTable.xsl”
    sResultFile = ThisWorkbook.Path & Application.PathSeparator & “result.html”
    ‘Load asynchronously
    oXML.async = False
    oXSL.async = False

    ‘Load XML
    bLoaded = oXML.Load(sDataFile)
    If Not bLoaded Then
    MsgBox oXML.parseError.Line & vbTab & oXML.parseError.reason, vbExclamation + vbOKOnly
    GoTo HandleExit
    End If

    bLoaded = oXSL.Load(sStylesheetFile)
    If Not bLoaded Then
    MsgBox oXSL.parseError.Line & vbTab & oXSL.parseError.reason, vbExclamation + vbOKOnly
    GoTo HandleExit
    End If

    sXML = oXML.transformNode(oXSL)

    Open sResultFile For Output As #1
    Print #1, sXML
    Close #1

    HandleExit:
    ‘Check if object exists as release
    If Not oXML Is Nothing Then Set oXML = Nothing
    If Not oXSL Is Nothing Then Set oXSL = Nothing
    Exit Sub

    HandleError:
    MsgBox Err.Number & vbTab & Err.Description, vbExclamation + vbOKOnly
    Resume HandleExit
    End Sub

    The resulting HTML file will show the data exported and formatted into a table.

  7. oops….looks like the stylesheet and xml did not save properly…

    XML Data File:

    <?xml version=”1.0″ encoding=”UTF-8″ standalone=”yes”?>
    <Root xmlns:xsi=”http://www.w3.org/2001/XMLSchema-instance”>
        <Row>
            <Name>John</Name>
            <Value>12.5</Value>
        </Row>
        <Row>
            <Name>Anne</Name>
            <Value>48.2</Value>
        </Row>
        <Row>
            <Name>Steven</Name>
            <Value>58.4</Value>
        </Row>
    </Root>

    Stylesheet file

    <?xml version=“1.0” encoding=“utf-8”?>
    <xsl:stylesheet version=“1.0” xmlns:xsl=“http://www.w3.org/1999/XSL/Transform”>
        <xsl:output method=“html” indent=“yes” encoding=“UTF-8”/>
        <xsl:template match=“/”>
            <html>
                <head>
                    <style type=“text/css”>
                        body * {font-family:Verdana;font-size:8pt}
                        th {background:#525252;color:#f2f2f2;text-align:left}
                        td {border-bottom:1px solid #999}
                        td.red {background:red}
                        td.green {background:yellowgreen}
                    </style>
                </head>
                <body>
                    <table cellpadding=“6” cellspacing=“1”>
                        <tr>
                            <th>Name</th>
                            <th>Value</th>
                        </tr>
                        <xsl:for-each select=“//Row”>
                            <xsl:sort select=“Name” data-type=“text” order=“ascending” />
                            <tr>
                                <td>
                                    <xsl:value-of select=“Name” />
                                </td>
                                <xsl:choose>
                                    <!– Use &gt; as a replacement for greater than symbol –>
                                    <xsl:when test=“Value&gt;20”>
                                        <td class=“red”>
                                            <xsl:value-of select=“Value” />
                                        </td>
                                    </xsl:when>
                                    <xsl:otherwise>
                                        <td class=“green”>
                                            <xsl:value-of select=“Value” />
                                        </td>
                                    </xsl:otherwise>
                                </xsl:choose>
                            </tr>
                        </xsl:for-each>
                    </table>
                </body>
            </html>
        </xsl:template>
    </xsl:stylesheet>
  8. I have a similar pool, but have kept from publishing on the web mainly because I have many macros running analysis on the data. Though simply publishing results in html might be pretty good way for people to keep track. I’ve had numerous requests to put my survivor pool on the web.

    From your original example it’s not clear where/how the source images are located and assigned to the data. Can you tell me how your source files match up with the team logo/picture? I don’t read it in your code.

    – RV

  9. The images are in the same directory as index.html – I ftp’d them up there. The are all named teammascotleft.bmp. So the Chicago helmet is named bearsleft.bmp. The MakeImage function makes an image tag that looks like

    <img src=”bearsleft.bmp” />

    Since there’s not path in the src argument, it looks in the same directory as the file with the img tag.

  10. Also, you’ll notice that when I record the picks in Excel, I use the lower case team mascot name. I have to do this because it builds the image tag from the cell value.

Leave a Reply

Your email address will not be published. Required fields are marked *