Custom Recordset-to-XML Function Demo

This demo illustrates a custom function that converts a Recordset's contents into an XML output. The Recordset used for this demo is a listing of the 10 most popular FAQs on ASPFAQs.com. (An updated version of this function has been created! This updated function enhances the performance of the ConvertRStoXML() function by using cloneNode() and GetRows(). You can view the updated version's demo or article.)


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
  objRS.Close
  Set objRS = Nothing
  

Function ConvertRStoXML(objRS, strTopLevelNodeName, strRowNodeName)
 Dim objDom
 Dim objRoot
 Dim objField
 Dim objFieldValue
 Dim objcolName
 Dim objattTabOrder
 Dim objPI
 Dim x
 Dim objRSField
 Dim objRow

 'Instantiate the Microsoft XMLDOM.
 Set objDom = server.CreateObject("Microsoft.XMLDOM")
 objDom.preserveWhiteSpace = True

 'Create your root element and append it to the XML document.
 Set objRoot = objDom.createElement(strTopLevelNodeName)
 objDom.appendChild objRoot

 Do While Not objRS.EOF
   Set objRow = objDom.CreateElement(strRowNodeName)

   For Each objRSField in objRS.Fields
     Set objField = objDom.createElement("field")

     Set objcolName = objDom.createAttribute("name")
     objcolName.Text = objRSField.Name
     objField.SetAttributeNode(objColName)

     Set objFieldValue = objDom.createElement("value")
     objFieldValue.Text = objRSField.Value


     objField.appendChild objFieldValue

     objRow.appendChild objField
   Next 

   objRoot.appendChild objRow

   objRS.MoveNext
 Loop

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

 ConvertRStoXML = objDom.xml

 'Clean up...
 Set objDom = Nothing
 Set objRoot = Nothing
 Set objField = Nothing
 Set objFieldValue = Nothing
 Set objcolName = Nothing
 Set objattTabOrder = Nothing
 Set objPI = Nothing
End Function
%>  


[Return to the article]