Figure 1 Titles Table from ADO Saved in XML File

Figure 2 Data Starting with rs:data

Figure 3 Retrieve Titles

  
Function RetrieveTitlesSimpleXML() As Variant
Dim vOutPut As Variant, sReturn As String
Dim i As Integer
Dim sTitle As String, sNotes As String
Dim sBeginTag As String
    Set oXML = New Generator
    Set rsTitle = New ADODB.Recordset 
    vOutPut = oXML.XMLDeclaration()    
    vOutPut = vOutPut & oXML.BeginTag("Books")
    sSQL = "SELECT * FROM titles"
    rsTitle.Open sSQL, GetDSN, adOpenForwardOnly, _    
        adLockReadOnly, adCmdText
        
    Do While Not rsTitle.EOF
        sTitle = oXML.Format("Title", rsTitle("title"))
        sNotes = oXML.Format("Notes", rsTitle("notes"))
        sBeginTag = oXML.BeginTag("Book", "TitleID", _ 
            rsTitle("title_id"))
        vOutPut = vOutPut & sBeginTag & sTitle & sNotes _
            & oXML.EndTag("Book")
        rsTitle.MoveNext
    Loop
    vOutPut = vOutPut & oXML.EndTag("Books")
    rsTitle.Close
    Set rsTitle = Nothing
    RetrieveTitlesSimpleXML = vOutPut
End Function

Figure 4 XMLParser

  
Option Explicit
Const xs = "<"
Const xe = ">"
Const xend = "</"

Public Function XMLDeclaration() As String
  XMLDeclaration = "<?xml version=""1.0""?>"
End Function

Public Function Format(XMLName As String, XMLValue As Variant) As String

    Select Case VarType(XMLValue)
    Case vbByte, vbInteger, vbSingle, vbDouble, vbDecimal, vbBoolean, _
        vbLong, vbCurrency
        Format = xs + XMLName + xe + Trim(Str(XMLValue)) + xend + _
                 XMLName + xe
    Case vbString, vbVariant, vbDate
        Format = xs + XMLName + xe + XMLValue + xend + XMLName + xe
    Case Else
        Format = ""
    End Select

End Function

Public Function BeginTag(XMLName As String, _
    Optional AttributeName As String = ""
    Optional AttributeData As String = "")
Dim sTempTag As String
    sTempTag = xs & XMLName
    
    If AttributeName <> "" Then
        sTempTag = sTempTag & " " & AttributeName & "=" & Chr(34) & _
                   AttributeData & """"
    End If
    
    BeginTag = sTempTag & xe
End Function

Public Function EndTag(XMLName As String)
    EndTag = xend & XMLName & xe
End Function

Figure 6 cmdXMLIntoMSXML

  
Private Sub cmdXMLIntoMSXML_Click()
Dim xmlDoc As MSXML.DOMDocument
Dim objNodeList As MSXML.IXMLDOMNodeList
Dim objNode As MSXML.IXMLDOMNode, i As Integer
Dim objAttribute As MSXML.IXMLDOMAttribute
Dim objNodeMap As MSXML.IXMLDOMNamedNodeMap
Dim objNamedItem As MSXML.IXMLDOMNode
Dim sXML As String
Dim sNodeToFind As String
    Set objPub = New Publication.Title
    Set xmlDoc = New MSXML.DOMDocument
    sXML = objPub.RetrieveTitlesSimpleXML()
    sNodeToFind = "Book"
    xmlDoc.async = False
    xmlDoc.loadXML (sXML)
    Set objNodeList = xmlDoc.getElementsByTagName(sNodeToFind)
    For i = 0 To (objNodeList.length - 1)
      Set objNode = objNodeList.nextNode
      
      Set objNodeMap = objNode.Attributes
      Set objNamedItem = objNodeMap.getNamedItem("TitleID")
      txtNotes = txtNotes & objNamedItem.Text & "  -  "
      txtNotes = txtNotes & objNode.Text & vbCrLf
    Next
    Set objPub = Nothing
    Set xmlDoc = Nothing
End Sub