MXHTMLWriter is a handy feature added to MSXML SAX2 in version 6.0, but few have probably heard of SAX and few still of MXHTMLWriter.
See MXHTMLWriter CoClass for an overview.
There are several ways to use MXHTMLWriter but here I'll turn it "inside out" by explicitly raising events to it via IVBSAXContentHandler instead of letting other parts of MSXML raise the events. This is a very basic example showing how to do that to write HTML, and in this case the demo involves simple reporting.
Depending on your purpose you might want the results in different ways. Here I show how to get file output, String output, and Byte array output (since for that we can get UTF-8 or other character encodings).
It should be plenty speedy enough for most purposes:
![Name: sshot.png
Views: 53
Size: 3.1 KB]()
Here is the crux of the demo:
The attachment contains some raw data, which is why it is so large.
MSXML 6.0 has been part of Windows since Vista. You might still be able to download a redist version for XP SP2 or maybe SP3 from Microsoft.
See MXHTMLWriter CoClass for an overview.
There are several ways to use MXHTMLWriter but here I'll turn it "inside out" by explicitly raising events to it via IVBSAXContentHandler instead of letting other parts of MSXML raise the events. This is a very basic example showing how to do that to write HTML, and in this case the demo involves simple reporting.
Depending on your purpose you might want the results in different ways. Here I show how to get file output, String output, and Byte array output (since for that we can get UTF-8 or other character encodings).
It should be plenty speedy enough for most purposes:
Here is the crux of the demo:
Code:
Private Sub Report(ByRef Dest As Variant, Optional ByVal Encoding As String = "ASCII")
'Dest: Can be an instance of an IStream implementation or a String.
'
'Encoding: Can be "UTF-8" or "Windows-1252" or "UTF-16" etc. as desired.
' Always ignored for String output which is always UTF-16
' ("Unicode").
Const REPORT_TITLE As String = "January 2009 Sales"
Const CSS_STYLES As String = vbNewLine _
& "*{font:normal normal normal 8pt Arial;}" & vbNewLine _
& "th,td{border:1px solid black;}" & vbNewLine _
& "th{background-color:royalblue;color:white;font-weight:bold;}" & vbNewLine _
& "td{background-color:white;color:green;}" & vbNewLine _
& "table,th,td{border-collapse:collapse;}" & vbNewLine _
& ".SH{color:red;}"
Dim Attrs As MSXML2.SAXAttributes60
Dim Handler As MSXML2.IVBSAXContentHandler
Dim Writer As MSXML2.MXHTMLWriter60
Dim FieldsUB As Long
Dim Fields() As ADODB.Field
Dim Col As Long
Dim Row As Long
Dim LatitudeField As Long
Dim Value As Variant
Set Attrs = New MSXML2.SAXAttributes60
Set Writer = New MSXML2.MXHTMLWriter60
Set Handler = Writer
With Writer
.disableOutputEscaping = False
.indent = True
.Encoding = "ASCII"
.byteOrderMark = True 'Has no effect for 8-bit encodings or any String output.
.output = Dest 'Can be an IStream implementation, or a String value to set
'the output type to String.
End With
With RS
.MoveFirst
FieldsUB = .Fields.Count - 1
ReDim Fields(FieldsUB)
For Col = 0 To FieldsUB
Set Fields(Col) = .Fields(Col)
If Fields(Col).Name = "Latitude" Then LatitudeField = Col
Next
End With
With Handler
.startDocument
.startElement "", "", "HTML", Attrs
.startElement "", "", "HEAD", Attrs 'Auto-emits a META tag for encoding.
Attrs.addAttribute "", "", "name", "", "generator"
Attrs.addAttribute "", "", "content", "", App.CompanyName _
& " " & App.EXEName _
& " " & CStr(App.Major) _
& "." & CStr(App.Minor)
.startElement "", "", "META", Attrs
Attrs.Clear
.endElement "", "", "META"
.startElement "", "", "TITLE", Attrs
.characters REPORT_TITLE
.endElement "", "", "TITLE"
Attrs.addAttribute "", "", "type", "", "text/css"
.startElement "", "", "STYLE", Attrs
Attrs.Clear
.characters CSS_STYLES
.endElement "", "", "STYLE"
.endElement "", "", "HEAD"
.startElement "", "", "BODY", Attrs
.startElement "", "", "TABLE", Attrs
.startElement "", "", "TR", Attrs
For Col = 0 To FieldsUB
.startElement "", "", "TH", Attrs
.characters Replace$(Fields(Col).Name, "_", " ")
.endElement "", "", "TH"
Next
.endElement "", "", "TR"
Do Until RS.EOF
'Hightlight rows for Southern Hemisphere:
If Fields(LatitudeField).Value < 0 Then
Attrs.addAttribute "", "", "class", "", "SH"
Else
Attrs.Clear
End If
.startElement "", "", "TR", Attrs
For Col = 0 To FieldsUB
.startElement "", "", "TD", Attrs
Value = Fields(Col).Value
If Not IsNull(Value) Then .characters CStr(Value)
.endElement "", "", "TD"
Next
.endElement "", "", "TR"
RS.MoveNext
Loop
.endElement "", "", "TABLE"
.endElement "", "", "BODY"
.endElement "", "", "HTML"
.endDocument
End With
With Writer
.Flush
If VarType(Dest) = vbString Then
Dest = .output 'Fetch String output.
End If
End With
End SubMSXML 6.0 has been part of Windows since Vista. You might still be able to download a redist version for XP SP2 or maybe SP3 from Microsoft.