Help passing XML String to RecordSet

Question

What I would like to do is dump an XML String into RecordSet. The problem I am having is that the code seems to work fine if I saved the XML String first to a file and then read from the file which I think is redundant. However, when I want to read from string, I get the error

RecordSet cannot be created. Source XML is incomplete or invalid. 80004005

My XML String is in the form

<portfolio>
   <stock>
      <shares>100</shares>
      <symbol>MSFT</symbol>
      <price>$70.00</price>
      <info>
         <companyname>Microsoft Corporation</companyname>
         <website>http://www.microsoft.com&lt;/website&gt;
      </info>
   </stock>
   <stock>
      <shares>100</shares>
      <symbol>AAPL</symbol>
      <price>$107.00</price>
      <info>
         <companyname>Apple Computer, Inc.</companyname>
         <website>http://www.apple.com&lt;/website&gt;
      </info>
   </stock>
   <stock>
      <shares>100</shares>
      <symbol>DELL</symbol>
      <price>$50.00</price>
      <info>
         <companyname>Dell Corporation</companyname>
         <website>http://www.dell.com&lt;/website&gt;
      </info>
    </stock>
    <stock>
       <shares>100</shares>
       <symbol>INTC</symbol>
       <price>$115.00</price>
       <info>
          <companyname>Intel Corporation</companyname>
          <website>http://www.intel.com&lt;/website&gt;
       </info>
   </stock>
</portfolio>

And the code I am using to convert the XML String(That I am having the problem with) is

Public Function RecordsetFromXMLString(sXML As String) As Recordset

    Dim oStream As ADODB.Stream
    Set oStream = New ADODB.Stream

    oStream.Open
    oStream.WriteText sXML   'Give the XML string to the ADO Stream

    oStream.Position = 0    'Set the stream position to the start

    Dim oRecordset As ADODB.Recordset
    Set oRecordset = New ADODB.Recordset

    oRecordset.Open oStream    'Open a recordset from the stream

    oStream.Close
    Set oStream = Nothing

    Set RecordsetFromXMLString = oRecordset  'Return the recordset

    Set oRecordset = Nothing

End Function

Please, your help will be greatly appreciated.

http://msdn.microsoft.com/en-us/library/ms810621

http://support.microsoft.com/kb/263247

I already tried using this below

Public Function RecordsetFromXMLDocument(XMLDOMDocument) 
    Dim oRecordset 
    Set oRecordset = CreateObject("ADODB.Recordset.6.0")
    oRecordset.Open XMLDOMDocument 'pass the DOM Document instance as the Source argument

    Set RecordsetFromXMLDocument = oRecordset  'return the recordset

    Set oRecordset = Nothing
End Function

But still ran into the same issue.

Answer 1

You are getting this error, because the XML you are supplying is not in the format that ADODB.Recordset understands. The format needs to resemble the following, which is based on XML-Data Reduced Schema. See the documentation on the ADO XML Persistence Format Protocol for more information.

<xml xmlns:s='uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882' 
    xmlns:rs='urn:schemas-microsoft-com:rowset' 
    xmlns:z='#RowsetSchema'>
<s:Schema id='RowsetSchema'>
    <s:ElementType name='row' content='eltOnly'>
        <s:AttributeType name='shares' rs:number='1' />
        <s:AttributeType name='symbol' rs:number='2' />
        <s:AttributeType name='price' rs:number='3' />
        <s:extends type='rs:rowbase'/>
    </s:ElementType>
</s:Schema>
<rs:data>
    <z:row shares='100' symbol='MSFT' price='$70.00'  />
    <z:row shares='100' symbol='AAPL' price='$107.00'  />
    <z:row shares='100' symbol='DELL' price='$50.00'  />
</rs:data>
</xml>

In the past when working with ADO and XML I've used XSLT to transform my XML format into ADO XML format. You can also do it programmatically. Here are a few examples (They are not VB6, but should give you an idea of what's needed).

http://support.microsoft.com/kb/316337

http://msdn.microsoft.com/en-us/magazine/cc301468.aspx

http://etutorials.org/Programming/Web+Solutions+based+on+ASP.NET+and+ADO.NET/Part+III+Interoperability/Interoperable+Web+Applications/From+DataSet+Objects+to+ADO+Recordset+Objects/

Answer 2

Code I used to Format my DomDocumentData into the ADO XML Persistent Format I required for this

'*******************************************************************************************
' SCHEMA GENERATOR
'*******************************************************************************************
'parentnodepath -- XPath to the Main Node/Table/RowCollection
'parentnodepath -- Name of the Main Node/Table/RowCollection
Function CreateSchemafromNode(XMLDocument,parentnodepath, parentnodeName)
        Dim schema, stemp, MyArray,nodename, childnodelist,counter, n, x, tempnode
        schema = TextWriterSchemaNameSpaceHeader()
        schema=schema & TextWriterSchemaHeader(parentnodeName)
        'LOOP HERE 
          counter = 0

            For Each stemp In XMLDocument.SelectSingleNode(parentnodePath).ChildNodes(0).ChildNodes
                    counter = counter + 1
                    schema = schema & TextWriterSchemaRowAttributeElement(stemp.NodeName, counter, "")
            Next
        'END LOOOP HERE
            schema=schema & TextWriterSchemaSchemaEnd
            schema =schema &  TextWriterSchemaRowHeader
           'BEGIN FIRST LOOP HERE -- FOR EACH TOP NODE --ROW
                For Each n In XMLDocument.SelectSingleNode(parentnodePath).ChildNodes
                        schema =schema & TextWriterSchemaAddRowBegin()
                    'BEGIN SECOND LOOP HERE -- FOR EACH CHILD OF TOP NODE -- NODE VALUE IN CURRENT ROW -- FOR EACH CHILDNODELIST NAME
                    For Each x In n.ChildNodes
                            schema = schema & TextWriterSchemaAddRowFieldNameValue(x.NodeName, x.text) 
                    'END SECOND LOOP HERE 
                    Next
                    schema =schema & TextWriterSchemaAddRowEnd()
           Next 
        'END FIRST LOOP HERE 
        schema =schema & TextWriterSchemaRowEnd()
        schema =schema &TextWriterSchemaNameSpaceEnd()

        CreateSchemafromNode=schema
End Function 


Function TextWriterSchemaNameSpaceHeader()
  Dim schemaString 

    schemaString= "<xml xmlns:s='"
    schemaString= schemaString & "uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882' " & vbCrLf & vbTab
    schemaString= schemaString & ("xmlns:dt='")
    schemaString= schemaString & "uuid:C2F41010-65B3-11d1-A29F-00AA00C14882' " & vbCrLf & vbTab
  ' schemaString= schemaString & ("xmlns:dt='")
  ' schemaString= schemaString & "uuid:C2F41010-65B3-11d1-A29F-00AA00C14882' " & vbCrLf & vbTab
    schemaString= schemaString & "xmlns:rs='urn:schemas-microsoft-com:rowset' "  & vbCrLf & vbTab
    schemaString=schemaString & " xmlns:z='#RowsetSchema'> " & vbCrLf 
    TextWriterSchemaNameSpaceHeader = schemaString 
End Function


Function TextWriterSchemaHeader(recordname)
     Dim schemaString 
            schemaString= "<s:Schema id='RowsetSchema'>"& vbCrLf & vbTab
            schemaString= schemaString &"<s:ElementType name='" & recordname & "' content='eltOnly'>" & vbCrLf 
            TextWriterSchemaHeader = schemaString 
End Function

Function TextWriterSchemaRowAttributeElement(rowname, rowordernumber, rowtype)
    Dim schemaString 
        schemaString=vbTab & vbTab & "<s:AttributeType  name='" & rowname & "'  rs:number='" & rowordernumber & "'  />" & vbCrLf 
        TextWriterSchemaRowAttributeElement = schemaString
End Function

Function TextWriterSchemaSchemaEnd()
      Dim schemaString 
        schemaString=vbTab & vbTab & "<s:extends type='rs:rowbase'/>" & vbCrLf 
        schemaString= schemaString &vbTab &  "</s:ElementType>" & vbCrLf 
        schemaString= schemaString & "</s:Schema>"  & vbCrLf 
        TextWriterSchemaSchemaEnd =schemaString
End Function

Function TextWriterSchemaRowHeader()
        Dim schemaString 
            schemaString= vbTab & "<rs:data>" & vbCrLf 
            TextWriterSchemaRowHeader = schemaString
End function

Function TextWriterSchemaAddRowBegin()
      Dim schemaString 
        schemaString=vbTab & "<z:row "
        TextWriterSchemaAddRowBegin=schemaString
End function

Function TextWriterSchemaAddRowFieldNameValue(FieldName, FieldValue)
    Dim schemaString 
            schemaString= FieldName & "='" & FieldValue & "' "
            TextWriterSchemaAddRowFieldNameValue=schemaString
End function

Function TextWriterSchemaAddRowEnd()
        Dim schemaString
           schemaString="/>"  & vbCrLf 
           TextWriterSchemaAddRowEnd=schemaString
End function


Function TextWriterSchemaRowEnd()
         Dim schemaString
              schemaString=vbTab & "</rs:data>" & vbCrLf 
               TextWriterSchemaRowEnd=schemaString
End function

Function TextWriterSchemaNameSpaceEnd()
         Dim schemaString
               schemaString="</xml>"  & vbCrLf 
               TextWriterSchemaNameSpaceEnd=schemaString
End Function