VBA - Populating ADO Recordset with contents from Worksheet (recognising column names)

Also from StackOverflow an interesting tip arose concerning the ability to populate an ADO recordset with the Xml persisted contents of a block of cells.  The sample code however did not work in that the recordset did not understand the column names, what was required was some manipulation of the Xml schema in between.  Here is some code

Option Explicit
Option Private Module

Const mlDATASHEET As Long = 1

Private Sub SetUpTestData_RunOnce()

    Dim vTestData As Variant
    vTestData = [{"FirstName","FamilyName","Role";"John","Snow","President";"Ygritte","Wild","Vice-President"}]
    
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Worksheets.Item(mlDATASHEET).Cells(1, 1).Resize(UBound(vTestData, 1), UBound(vTestData, 2))
    rng.Value = vTestData

End Sub

Private Sub Test_RunMany()
    
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Worksheets.Item(mlDATASHEET).Cells(1, 1).CurrentRegion
    Dim sDataAsXml As String
    sDataAsXml = rng.Value(xlRangeValueMSPersistXML)
    '*DEBUG VBA.CreateObject("Scripting.FileSystemObject").CreateTextFile("c:\temp\xl_persist.xml").Write sDataAsXml
    
    'Tools->References:Microsoft ActiveX Data Object 6.1 Library
    Dim rs As ADODB.Recordset
    
    'Tools->References:Microsoft Xml, v6.0
    Dim domXlPersist As MSXML2.DOMDocument60
    Set domXlPersist = New MSXML2.DOMDocument60
    domXlPersist.setProperty "SelectionLanguage", "XPath"
    domXlPersist.setProperty "SelectionNamespaces", "xmlns:x='urn:schemas-microsoft-com:office:excel'" & _
         " xmlns:dt='uuid:C2F41010-65B3-11d1-A29F-00AA00C14882' " & _
         " xmlns:s='uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882' " & _
         " xmlns:rs='urn:schemas-microsoft-com:rowset' xmlns:z='#RowsetSchema'"
    domXlPersist.LoadXML sDataAsXml
    
    Dim attrTypeLoop As MSXML2.IXMLDOMNodeList
    Set attrTypeLoop = domXlPersist.SelectNodes("xml/x:PivotCache/s:Schema/s:AttributeType")
    
    Dim xmlFirstDataRow As MSXML2.IXMLDOMElement
    Set xmlFirstDataRow = domXlPersist.SelectSingleNode("xml/x:PivotCache/rs:data/z:row[1]")
    
    Dim attrColLoop As MSXML2.IXMLDOMAttribute, lLoop As Long
    For Each attrColLoop In xmlFirstDataRow.Attributes
        
        Dim attrType As MSXML2.IXMLDOMElement
        Set attrType = attrTypeLoop.Item(lLoop)
        
        Call attrType.setAttribute("rs:name", attrColLoop.Value)
        
        
        lLoop = lLoop + 1
    Next attrColLoop


    xmlFirstDataRow.ParentNode.RemoveChild xmlFirstDataRow
    Set xmlFirstDataRow = Nothing
    
    '*DEBUG  VBA.CreateObject("Scripting.FileSystemObject").CreateTextFile("c:\temp\xl_persist_2.xml").Write domXlPersist.XML
    
    'STOP
    
    
    Set rs = New ADODB.Recordset
    rs.Open domXlPersist

    
    'Stop


    Debug.Assert rs.Fields.Count = 3
    Debug.Assert rs.Fields.Item(0).Name = "FirstName"
    Debug.Assert rs.Fields.Item(1).Name = "FamilyName"
    Debug.Assert rs.Fields.Item(2).Name = "Role"
    
    Debug.Assert rs.RecordCount = 2
    
    rs.Filter = "FirstName='John'"
    
    Debug.Assert rs.RecordCount = 1
    
    Stop

End Sub

If you uncomment the debug line then you'll write an interim xml file, if you're interested in the contents here they are

<xml xmlns:x="urn:schemas-microsoft-com:office:excel" 
    xmlns:dt="uuid:C2F41010-65B3-11d1-A29F-00AA00C14882" 
    xmlns:s="uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882" 
    xmlns:rs="urn:schemas-microsoft-com:rowset" 
    xmlns:z="#RowsetSchema">
<x:PivotCache>
<x:CacheIndex>1</x:CacheIndex>
<s:Schema id="RowsetSchema">
<s:ElementType name="row" content="eltOnly">
<s:attribute type="Col1"/>
<s:attribute type="Col2"/>
<s:attribute type="Col3"/>
<s:extends type="rs:rowbase"/>
</s:ElementType>
<s:AttributeType name="Col1" rs:name="FirstName">
<s:datatype dt:maxLength="255"/>
</s:AttributeType>
<s:AttributeType name="Col2" rs:name="FamilyName">
<s:datatype dt:maxLength="255"/>
</s:AttributeType>
<s:AttributeType name="Col3" rs:name="Role">
<s:datatype dt:maxLength="255"/>
</s:AttributeType>
</s:Schema>
<rs:data>
<z:row Col1="John" Col2="Snow" Col3="President"/>
<z:row Col1="Ygritte" Col2="Wild" Col3="Vice-President"/>
</rs:data>
</x:PivotCache>
</xml>

So actually this is some useful code for rustling up a sample recordset.