Sub test()
    Dim rs0 As ADODB.Recordset
    Dim rs1 As ADODB.Recordset
    Dim rs2 As ADODB.Recordset
    Dim xmlDoc1 As MSXML2.DOMDocument
    Dim xmlDoc2 As MSXML2.DOMDocument
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlNode1 As MSXML2.IXMLDOMNode
    Dim xmlNode2 As MSXML2.IXMLDOMNode
    '
    Set rs0 = New ADODB.Recordset
    Set rs1 = New ADODB.Recordset
    Set rs2 = New ADODB.Recordset
    Set xmlDoc1 = New MSXML2.DOMDocument
    Set xmlDoc2 = New MSXML2.DOMDocument
    
    rs1.Open "select 1 as f1, 3 as f2", CurrentProject.Connection
    rs2.Open "select 2 as f1, 4 as f2", CurrentProject.Connection
    
    '   ********************************************
    rs1.Save xmlDoc1, adPersistXML
    rs2.Save xmlDoc2, adPersistXML
    
    Set xmlNode1 = xmlDoc1.getElementsByTagName("rs:data").Item(0)
    Set xmlNode2 = xmlDoc2.getElementsByTagName("rs:data").Item(0)
    
    For Each xmlNode In xmlNode2.childNodes
        xmlNode1.appendChild xmlNode
    Next
    '
    rs0.Open xmlDoc1
    '   ********************************************
    
    With rs0
        .MoveFirst
        Do While Not .EOF
            Debug.Print .Fields(0), .Fields(1)
            .MoveNext
        Loop
    End With
    '
    rs0.Close: Set rs0 = Nothing
    rs1.Close: Set rs1 = Nothing
    rs2.Close: Set rs2 = Nothing
    Set xmlDoc1 = Nothing
    Set xmlDoc2 = Nothing
End Sub

cn.Open "строка подключения к Экселю с Jet или ACE провайдером"
strSQL = _ 
"select f1, f2, .... from ExcelTab " & _
"union all " & _
"select f1, f2, .... from OracleTab in ''[ODBC;Driver={Microsoft ODBC for Oracle};Server=myServerAddress;Uid=myUsername;Pwd=myPassword;]"

rs.Open strSQL, cn

Function UnionRS(ParamArray rs()) As ADODB.Recordset
    Dim i As Long
    Dim result As ADODB.Recordset
    Dim xmlDoc As MSXML2.DOMDocument
    Dim xmlDocTmp As MSXML2.DOMDocument
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlNodeRSData As MSXML2.IXMLDOMNode
    '
    If UBound(rs) < 0 Then
        MsgBox "Бяда !", vbCritical
        Exit Function
    End If
    '
    Set xmlDoc = New MSXML2.DOMDocument
    Set xmlDocTmp = New MSXML2.DOMDocument

    rs(0).Save xmlDoc, adPersistXML
    Set xmlNodeRSData = xmlDoc.getElementsByTagName("rs:data").Item(0)
    '
    For i = 1 To UBound(rs)
        rs(i).Save xmlDocTmp, adPersistXML
        For Each xmlNode In xmlDocTmp.getElementsByTagName("rs:data").Item(0).childNodes
            xmlNodeRSData.appendChild xmlNode
        Next
    Next i
    '
    Set result = New ADODB.Recordset
    result.Open xmlDoc
    '
    Set UnionRS = result
    '
    Set xmlDoc = Nothing
    Set xmlDocTmp = Nothing
End Function

Private Sub CommandButton1_Click()
   Dim rsA As New ADODB.Recordset
   rsA.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Temp\RR10.xls;Extended Properties=""Excel 8.0;HDR=YES;IMEX=1"""
   'rsA.Source = "select F1 from [Excel 8.0;HDR=YES;IMEX=1;DATABASE=C:\Temp\RR10.xls].[RR]"
   rsA.Source = "select F1 from [RR] in '[ODBC;Driver={Driver do Microsoft Excel(*.xls)};DBQ=C:\Temp\RR10.xls]'"
   rsA.Open
   Do While Not rsA.EOF
     MsgBox rsA.Fields("F1")
     rsA.MoveNext
   Loop
   rsA.Close
   Set rsA = Nothing
End Sub
 

select f1, f2, .... from OracleTab in ''[ODBC;Driver={Microsoft ODBC for Oracle};Server=myServerAddress;Uid=myUsername;Pwd=myPassword;]