Custom Recordset-to-XML Function Demo

This demo illustrates a custom function that converts a Recordset's contents into an XML output using cloneNode() and GetRows(). The Recordset used for this demo is a listing of the 10 most popular FAQs on (You can also view the older demo, which uses the XML DOM to convert the Recordset's data into XML.)

Demo Links:

Source Code:
  Dim objRS
  Set objRS = Server.CreateObject("ADODB.Recordset")

  objRS.Open "sp_Popularity", "DSN=MyDSN"

  'Output the XML
  Response.ContentType = "text/xml"
  Response.Write(ConvertRStoXML(objRS, "popular_faqs", "faq"))
  'Clean up
  Set objRS = Nothing

Function ConvertRStoXML(objRS, strTopLevelNodeName, strRowNodeName)
	Dim objXMLDom
	Dim objXMLRoot
	Dim objattTabOrder
	Dim objPI
	Dim Field
	Dim aryRows, intCurRowIdx, intCurFieldIdx, intNumFields, intNumRows
	Dim objXMLRow, objXMLField, objXMLFieldName, objXMLFieldValue, objXMLNodeList
	'Instantiate the Microsoft XMLDOM.
	Set objXMLDom = Server.CreateObject("Microsoft.XMLDOM")
	objXMLDom.preserveWhiteSpace = True

	'Create the root element and append it to the XML document.
	Set objXMLRoot = objXMLDom.createElement(strTopLevelNodeName)
	objXMLDom.appendChild objXMLRoot

	'Create the Row and Field elements
	Set objXMLRow = objXMLDom.CreateElement(strRowNodeName)
	Set objXMLField = objXMLDom.createElement("field")

	'Build the Field element including its attribute and child
	Set objXMLFieldName = objXMLDom.createAttribute("name")
	Set objXMLFieldValue = objXMLDom.createElement("value")
	objXMLField.appendChild objXMLFieldValue

	'Build the template row by adding all the field names from the Recordset
	For Each Field in objRS.Fields
		Call objXMLField.SetAttribute("name", Field.Name)
		objXMLRow.appendChild objXMLField

		'Copy the field to give it a new memory address (copy all its children too)
		Set objXMLField = objXMLField.cloneNode(True)

	'Convert our Recordset to the multi-dimensional array and calculate its bounds
	aryRows = objRS.getRows()

	intNumFields = UBound(aryRows)
	intNumRows = UBound(aryRows, 2)

	'Iterate through the array of data and build the Rows
	For intCurRowIdx = 0 To intNumRows
		'Retrieve all the Field nodes within the Row
		Set objXMLNodeList = objXMLRow.getElementsByTagName("field")
		'Add the data for the fields.
		'We know there's only one child for each Field (the FieldValue node) so the FirstChild property will work fine
		For intCurFieldIdx = 0 To intNumFields
			Set objXMLField = objXMLNodeList.item(intCurFieldIdx)
			Set objXMLFieldValue = objXMLField.FirstChild
			objXMLFieldValue.text = aryRows(intCurFieldIdx, intCurRowIdx)

		'Build the populated Row
		objXMLRoot.appendChild objXMLRow

		'Copy the current row to give it a new memory address (copy children too)
		Set objXMLRow = objXMLRow.CloneNode(True)

	Set objPI = objXMLDom.createProcessingInstruction("xml", "version='1.0'")
	objXMLDom.insertBefore objPI, objXMLDom.childNodes(0)

	ConvertRStoXML = objXMLDom.xml

	'Clean up...
	Set aryRows = Nothing
	Set objXMLDom = Nothing
	Set objXMLRoot = Nothing
	Set objXMLField = Nothing
	Set objXMLFieldValue = Nothing
	Set objXMLFieldName = Nothing
	Set objattTabOrder = Nothing
	Set objPI = Nothing
End Function

[Return to the article]