How to Join Two Recordset Created from Two Different Data Source in Excel Vba

How to join two recordset created from two different data source in excel vba

Consider the below example using ADO. The code allows to get data from several data sources within single SQL query (Jet SQL), particularly make unions from .xlsx files, and put result recordset to the worksheet. Unfortunately I have no available Oracle data source to test, though you can connect directly to Oracle also with ADO (like any other database) via Oracle ODBC driver.

The code is placed in Query.xlsm:

Option Explicit

Sub SqlUnionTest()

    Dim strConnection As String
    Dim strQuery As String
    Dim objConnection As Object
    Dim objRecordSet As Object

    strConnection = _
        "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "User ID=Admin;" & _
        "Data Source='" & ThisWorkbook.FullName & "';" & _
        "Mode=Read;" & _
        "Extended Properties=""Excel 12.0 Macro;"";"

    strQuery = _
        "SELECT * FROM [Sheet1$] " & _
        "IN '" & ThisWorkbook.Path & "\Source1.xlsx' " & _
        "[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;'] " & _
        "UNION " & _
        "SELECT * FROM [Sheet1$] " & _
        "IN '" & ThisWorkbook.Path & "\Source2.xlsx' " & _
        "[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;'] " & _
        "UNION " & _
        "SELECT * FROM [Sheet1$] " & _
        "IN '" & ThisWorkbook.Path & "\Source3.xlsx' " & _
        "[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;'] " & _
        "ORDER BY ContactName;"

    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Open strConnection
    Set objRecordSet = objConnection.Execute(strQuery)
    RecordSetToWorksheet Sheets(1), objRecordSet
    objConnection.Close

End Sub

Sub RecordSetToWorksheet(objSheet As Worksheet, objRecordSet As Object)

    Dim i As Long

    With objSheet
        .Cells.Delete
        For i = 1 To objRecordSet.Fields.Count
            .Cells(1, i).Value = objRecordSet.Fields(i - 1).Name
        Next
        .Cells(2, 1).CopyFromRecordset objRecordSet
        .Cells.Columns.AutoFit
    End With

End Sub

Note, ThisWorkbook.Path should not contain ' within path. Otherwise you have to escape them by replacing ' with ''.

Also there are three data source files in the same folder as Query.xlsm.

Source1.xlsx:

Source2.xlsx:

Source3.xlsx:

The resulting worksheet is as follows:

It works on 64-bit version Excel 2013 for me. To make it compatible with .xls and Excel 2003 (where the provider ACE.OLEDB.12.0 isn't installed) you have to replace Provider=Microsoft.ACE.OLEDB.12.0; with Provider=Microsoft.Jet.OLEDB.4.0;, and also in extended properties Excel 12.0 Macro; / Excel 12.0; with Excel 8.0;. You can easily add WHERE clause and other SQL stuff to the query. Actually data source for connection object isn't limited the only Query.xlsm file, which the code placed in. It could be another data source, compatible with one of the available providers, either file-based or server-based. Find more connection strings for your data source on http://www.connectionstrings.com/

Possible to join two recordsets using VBA/ADO?

You reported this line triggers the error:

Set ObjRecordset3 = "SELECT * FROM " & Access_Recordset

The right side of the = sign attempts to concatenate a string with an ADODB.Recordset object. That is probably the immediate cause of the compile error. However, that's not the only problem with that line. Set <recordset object> = "any string value" will not work. And finally, Access SQL does not support FROM <recordset object> for any type of recordset object (ADO or DAO).

I think you should look for a simpler approach. In following query, dbo_BigIntTable is an ODBC link to a SQL Server table. It includes a field, bigint_fld, whose SQL Server data type is BigInt. However, Access sees that field as Text type. Therefore I can join it with the string equivalent of a Long Integer field (tblFoo.id).

SELECT tblFoo.id, dbo_BigIntTable.bigint_fld
FROM
    tblFoo
    INNER JOIN dbo_BigIntTable
    ON CStr(tblFoo.id) = dbo_BigIntTable.bigint_fld;

The Access query designer complained it can't display that join in Design View, but I was able create the join from SQL View and it worked fine.

One RecordSet with multiple Connections & SQL Querys

I would still recommend "CopyFromRecordset", there is some coding involved but I don't think the process will be significantly slowed down, maybe a fraction of a second

Use SQL to combine files from different locations in Excel

Consider the multiple LEFT JOIN query assuming all CSV files share the same ID field. NOTE: SQL queries requires parentheses pairings for every FROM table and JOIN table.

StrSQL= "SELECT * " _
         & " FROM ((samplesheet.csv t1 " _
         & " LEFT JOIN [text;database=" & ThisWorkbook.Path & "].samplesheet2.csv AS t2" _
         & "    ON t1.ID = t2.ID)" _
         & " LEFT JOIN [text;database=" & ThisWorkbook.Path & "].samplesheet3.csv AS t3" _
         & "    ON t1.ID = t3.ID)"

Do note there is a finite limit of JOIN statements allowed for any JET/ACE Engine query like this one which depends on data.

For large number of CSV files, consider iterating through directory. Below copies each recordset to adjacent placement by columns. NOTE: no ID joins are used here due to iterative process. Data is simply placed side by side.

Dim objConnection As Object, objRecordSet As Object
Dim lastColumn As Long
Dim csvFile As String, StrSQL As String

Set objConnection = CreateObject("ADODB.Connection")

objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                   "Data Source=" & ThisWorkbook.Path & ";" & _
                   "Extended Properties=""text;HDR=YES;FMT=Delimited"""

csvFile =  Dir(ThisWorkbook.Path & "\*csv")

Do While Len(csvFile) > 0

    StrSQL = "SELECT * FROM [" & csvFile & "] ORDER BY ID;"

    ' INITIALIZE RECORDSET
    Set objRecordSet = CreateObject("ADODB.Recordset")    
    objRecordSet.Open StrSQL, objConnection

    ' SAVE TO WORKSHEET
    With ThisWorkbook.Worksheets("Sheet1")
        lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        .Range(.Cells(1, lastColumn), .Cells(1, lastColumn)).CopyFromRecordset objRecordSet 
    End With

    ' UNINITIALIZE RECORDSET
    objRecordSet.Close
    Set objRecordSet = Nothing

    csvFile = Dir
Loop

objConnection.Close
Set objConnection = Nothing

---

Related Topics