Reputation: 6545
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</website>
</info>
</stock>
<stock>
<shares>100</shares>
<symbol>AAPL</symbol>
<price>$107.00</price>
<info>
<companyname>Apple Computer, Inc.</companyname>
<website>http://www.apple.com</website>
</info>
</stock>
<stock>
<shares>100</shares>
<symbol>DELL</symbol>
<price>$50.00</price>
<info>
<companyname>Dell Corporation</companyname>
<website>http://www.dell.com</website>
</info>
</stock>
<stock>
<shares>100</shares>
<symbol>INTC</symbol>
<price>$115.00</price>
<info>
<companyname>Intel Corporation</companyname>
<website>http://www.intel.com</website>
</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.
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
Upvotes: 0
Views: 2979
Reputation: 16828
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
Upvotes: 1