Binaryworld - Connect a stand-alone Recordset to a database using XML ... [ VB -> ADO ]

If you are familiar with the ADO capability to create stand-alone Recordsets from the thin air, that is by adding items to their Fields collection, you're also probably aware that this feature has a serious shortcoming: you can't then connect to a database and perform any batch updates. The problem is that a stand-alone Recordset has an empty Source property, and when you reconnect it to the database you get the error "Insufficient Base Table Information".

What is missing in a stand-alone Recordset are three field attributes that indicate from which database, table and field the corrisponding value comes. If you create a new Field object using the Fields.Append method you can't specify these properties, nor you can add them later because field properties can't be extended.

If you're working with ADO 2.1 and Internet Explorer 5 is installed on the machine, however, there is a technique that lets you work around this issue:

You create a stand-alone Recordset, open it, and append all the fields you know for sure are in the target database table. You save the Recordset in XML format (that's why you need ADO 2.1).
You reload the resulting XML document (you need IE 5 and a reference to the MSXML library to do so).
You manipulate the document and add the missing field attributes
You save the modified XML document, and re-open it as a Recordset.
From this point on, the Recordset can be associated a valid connection, and you can use it to upload data to the database.
I've prepared a reusable procedure that takes the name of the saved XML file, and the name of the Base Catalog (i.e. the database) and the Base Table, and performs all the XML manipulations for you:

Click here to copy the following block

' Requires IE 5 and a reference to
' the ADO 2.5 and the MSXML2 type library

Sub LinkRsToDB(ByVal rs As ADODB.Recordset, ByVal BaseCatalog As String, _
  ByVal BaseTable As String)
  Dim DOMDoc As New DOMDocument
  Dim Root As IXMLDOMNode
  Dim Schema As IXMLDOMNode
  Dim Node As IXMLDOMNode
  Dim Item As IXMLDOMNode
  Dim NewItem As IXMLDOMAttribute

  ' open the recordset if necessary
  If (rs.State And adStateOpen) = 0 Then rs.Open

  ' save the recordset directly into the XML parser
  rs.Save DOMDoc, adPersistXML

  ' the Schema is the first node under the root
  Set Root = DOMDoc.childNodes.Item(0)
  Set Schema = Root.childNodes(0)

  For Each Node In Schema.childNodes(0).childNodes
    If UCase(Node.baseName) = "ATTRIBUTETYPE" Then
      For Each Item In Node.Attributes
        If Item.baseName = "write" Then
          ' Remove this attribute, which is unsupported
          ' when the Recordset will be loaded
          Node.Attributes.removeQualifiedItem Item.baseName, _
            Item.namespaceURI
          Exit For
        End If
      Next

      ' Create missing attribute for the Recordset
      Set NewItem = DOMDoc.createAttribute("rs:basecatalog")
      NewItem.Value = BaseCatalog
      Node.Attributes.setNamedItem NewItem

      Set NewItem = DOMDoc.createAttribute("rs:basetable")
      NewItem.Text = BaseTable
      Node.Attributes.setNamedItem NewItem

      Set NewItem = DOMDoc.createAttribute("rs:basecolumn")
      ' Assumes that the logical name is equal to the physiscal name
      NewItem.Text = Node.Attributes(0).Text
      Node.Attributes.setNamedItem NewItem

      ' this attribute is requested under ADO 2.5
      Set NewItem = DOMDoc.createAttribute("rs:writeunknown")
      NewItem.Text = "true"
      Node.Attributes.setNamedItem NewItem
    End If
  Next

  ' reload the recordset from the parser
  rs.Close
  rs.Open DOMDoc
End Sub

Here is an example of how you can use this technique. First, you need to create a stand-alone Recordset, whose Fields structure matches the structure of the database table you want to update, and add one or more records to it:

Click here to copy the following block

Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection

rs.Fields.Append "au_id", adVarChar, 11
rs.Fields.Append "au_lname", adVarChar, 40
rs.Fields.Append "au_fname", adVarChar, 20
rs.Fields.Append "phone", adChar, 12
rs.Fields.Append "address", adVarChar, 40
rs.Fields.Append "city", adVarChar, 20
rs.Fields.Append "state", adChar, 2
rs.Fields.Append "zip", adChar, 5
rs.Fields.Append "contract", adBoolean

' Add a new record to it
rs.Open
rs.AddNew
rs("au_id") = "978-43-6543"
rs("au_fname") = "Francesco"
rs("au_lname") = "Balena"
rs("city") = "Menlo Park"
rs("State") = "CA"
rs("Zip") = "94025"
rs("Contract") = 1
rs.Update

Now you can call the LinkRsToDB routine to make the recordset connectable, then you open the actual connection, and perform the insert operations:

Click here to copy the following block

' use the LinkRsToDB routine to modify the Recordset
' and enable it to be connected to a database:
LinkRsToDB rs, BaseCatalog:="Pubs", BaseTable:="Authors"

' open the actual connection and associate it to the recordset
cn.Open "DSN=Pubs"
Set rs.ActiveConnection = cn

' Update the database
' (without executing LinkRsToDB proc, you would have an error
' "Insufficient base table information for updating or refreshing.")
rs.UpdateBatch

Note: the above code works with ADO 2.5 and 2.6, the MSXML 2.0 type library, and SQL Server 7. You need ADO 2.5 or later because the LinkRsToDB routine persists and depersists the Recordset directly into the XML Parser. Instead, the following version of LinkRsToDB has been tested with ADO 2.1, and works with a temporary file:

Click here to copy the following block

' Requires ADO 2.1 and the MSXML 2.0 type library

Sub LinkRsToDB(ByVal rs As ADODB.Recordset, ByVal BaseCatalog As String, _
  ByVal BaseTable As String)
  Dim DOMDoc As New DOMDocument
  Dim Root As IXMLDOMNode
  Dim Schema As IXMLDOMNode
  Dim Node As IXMLDOMNode
  Dim Item As IXMLDOMNode
  Dim NewItem As IDOMAttribute
  Dim XMLSource As String
  Dim tempFileName As String
  Dim fileNum As Integer

  ' change this file name or use the GetTempFile routine
  ' elsewhere in vb2themax's Code Bank
  tempFileName = "C:\Empty.xml"
  ' ensure the file isn't there
  On Error Resume Next
  Kill tempFileName
  On Error GoTo 0

  ' open the recorset if necessary
  If (rs.State And adStateOpen) = 0 Then rs.Open

  ' save the recordset to the temporary file in XML format
  rs.Save tempFileName, adPersistXML

  ' reload the XML text into the parser
  DOMDoc.Load tempFileName
  Set Root = DOMDoc.childNodes.Item(0)
  Set Schema = Root.childNodes(0)

  For Each Node In Schema.childNodes
    If UCase(Node.baseName) = "ATTRIBUTETYPE" Then
      For Each Item In Node.Attributes
        If Item.baseName = "write" Then
          ' Remove this attribute, which is unsupported
          ' when the Recordset will be loaded
          Node.Attributes.removeNamedItem Item.nodeName
          Exit For
        End If
      Next

      ' Create missing attribute for the Recordset
      Set NewItem = DOMDoc.createAttribute("rs:basecatalog")
      NewItem.Value = BaseCatalog
      Node.Attributes.setNamedItem NewItem

      Set NewItem = DOMDoc.createAttribute("rs:basetable")
      NewItem.Value = BaseTable
      Node.Attributes.setNamedItem NewItem

      Set NewItem = DOMDoc.createAttribute("rs:basecolumn")
      ' Assumes that the logical name is equal to the physical name
      NewItem.Value = Node.Attributes(0).nodeValue
      Node.Attributes.setNamedItem NewItem
    End If
  Next

  ' ADO Recordsets know only the apostrophe char
  XMLSource = Replace(DOMDoc.xml, Chr(34), "'")

  ' save modified XML back to the temporary file
  Kill tempFileName
  fileNum = FreeFile
  Open tempFileName For Output As #fileNum
  Print #fileNum, XMLSource
  Close #fileNum

  ' reload the recordset from there
  rs.Close
  rs.Open tempFileName, , , , adCmdFile

  ' delete the temporary file
  Kill tempFileName
End Sub

The following example shows how to connect a stand-alone Recordset to the Authors table in Biblio. Note that in this case you can pass a null string to the BaseCatalog argument:

Click here to copy the following block

Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection

' only one field in this example
rs.Fields.Append "Author", adVarChar, 50
rs.Open

' Add a new record to it
rs.AddNew
rs("author") = "Francesco Balena"
rs.Update

' make the recordset connectable
LinkRsToDB rs, BaseCatalog:="", BaseTable:="Authors"

' this data link points to Biblio.mdb
cn.Open "File Name=C:\DataLinks\Biblio.udl"
Set rs.ActiveConnection = cn

' send updates to the database
rs.UpdateBatch