Join two workbooks via VBA SQL

Question

Hi, I have a workbook containing a data set saved on my PC. I would like to run an SQL statement in VBA using 'fields' in the current open workbook, and the workbook that is saved on my PC. I can do this on a row by row basis, but with 10k rows, it is much too slow. Is there a way to run an UPDATE query based on a join between the open workbook data range and the saved workbook data range? Heaps of help available for SQL Server / Excel, but nothing found for Excel/Excel.

I have tried using MSQuery, by creating a new data source, but can't add a second workbook to the query. Message - Couldn't access "C:\xyz.xls". If I choose c:\xyz.xls as the primary file and then try to add the other file, the same thing happens Couldn't access "C:\abc.xls".

Answer 1

Hi Guys,

Thanks for your responses, however,

One workbook, two worksheets, easy and have done many time, whether the active workbook, or a file on the PC. I am looking for a solution for joining an active workbook, with a data range named, to a file on my PC also with a data range named. An example follows, but with txt files. These like the one workbook, two worksheets are easy, in the case of the text files, because the structure of the connect string only references the folder containing the data files, and the schema.ini file contains the file structures. I have many examples of this as well.

Example of what I want using Excel, not txt or csv files. Note the file names for the two text files appears in the last segment where the join occurs.

With Sheets("Customer").QueryTables.Add(Connection:=Array(Array( _

        "ODBC;DefaultDir=" & ActiveWorkbook.Path & ";Driver={Microsoft Text Dr" _

        ), Array( _

        "iver (*.txt; *.csv)};DriverId=27;Extensions=txt,csv,tab,asc;FIL=text;MaxBufferSize=2048;MaxScanRows=25;PageTimeout=5;SafeTransa" _

        ), Array("ctions=0;Threads=3;UID=admin;UserCommitSync=Yes;")), Destination:= _

        Sheets("Customer").Range("A1"))

        .CommandText = Array( _

        "SELECT Customers.Customer, Customers.NAME 1, Customers.NAME 2" _

        , _

        ", Customers.STREET, Customers.CITY, Customers.POSTALCODE," _

        , _

        "Finance.CREDIT LIMIT, Finance.EXPOSURE" & Chr(13) & "" & Chr(10) & "FROM Customers.txt Customers INNER JOIN " & _

        " Finance.csv Finance ON CUSTOMERS.Customer = Finance.Customer")

The code I am looking for, if it exists, must be suitable to be run in an Add-in with the rest of what I am doing.

Edit 02/03/2014

I have given up on there being a solution for joining two Excel workbooks, and gone the clunky way of copying the data set onto a new worksheet in the active workbook. I can then use the two named data ranges in the active workbook to run the SQL UPDATE function. While this is A solution, it is not as elegant as being able to do it with two separate workbooks.

Routine to open ADO connection:

Sub ConnectToExcelPivot()

On Error Resume Next

strFileToStartWith = ActiveWorkbook.Path & "" & ActiveWorkbook.Name

Set mExcelConn = New ADODB.Connection

    mExcelConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _

                              & "Data Source=" _

                              & strFileToStartWith & ";" _

                              & "Extended Properties=Excel 8.0;"

If Err.Number <> 0 Then

    mExcelConn.ConnectionString = "Microsoft.ACE.OLEDB.12.0;" _

                              & "Data Source=" _

                              & strFileToStartWith & ";" _

                              & "Extended Properties=Excel 12.0 Xml;"

End If

On Error GoTo 0

    mExcelConn.Open

    Set mExcelCmd = New ADODB.Command

    Set mExcelCmd.ActiveConnection = mExcelConn

    mExcelCmd.CommandType = adCmdText

End Sub

Excerpt from code:

strSQL = "UPDATE data1 INNER JOIN Data2 " _

        & "ON data1.RenewalCheck = Data2.Key SET " _

        & "Data2.Old_ExpiryDate = [data1]![ExpiryDate];"

'Set command text to SQL statement

mExcelCmd.CommandText = strSQL

On Error Resume Next

'Execute SQL statement

Set mExcelRst = mExcelCmd.Execute

On Error GoTo 0

'Close connection to .xls workbook

DisconnectFromExcel

End Excerpt from code

Routine to close ADO connections:

Sub DisconnectFromExcel()

On Error Resume Next

Set mExcelCmd = Nothing

    mExcelConn.Close

    Set mExcelConn = Nothing

End Sub

This saves using VLOOKUP, updating one row at a time via a loop and ADO connection to the data source workbook and keeps the code available to a once off data set using an Add-In approach.

Please mark this question answered and close the thread, thanks.

Answer 2

Hi,

1. both wbks are in one folder

in path "c:\ADODB Folder"

2. i assume that

2a) abc.xls is open and xyz.xls is closed

2b) abc.xls is the target wb and xyz is the source wb

2c) in both wbks are headers in row 1

3. in workbook abc.xls, target sheet is the active sheet (no matter the name)

3a) export data from xyz.xls from sheet named: SourceSht and range A1:D50

4. write the code below, in a regular module, in workbook abc.xls

(change Bold sections as needed)

Sub ADODB_Conn_01()

' this workbook(abc.xls) is the target wb

'data from xyz file, from SourceSht - range A1:D50

Dim r As Long

r = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

Dim obj As Object

Set obj = CreateObject("ADODB.Connection")

Dim myPath

myPath = "c:\ADODB Folder\xyz.xls" ' <<< source workbook

With obj

.Provider = "Microsoft.Jet.OLEDB.4.0"

.ConnectionString = "Data Source=" & myPath & ";Extended Properties=Excel 8.0;"

.Open

End With

ActiveSheet.Cells(r, "A").CopyFromRecordset obj.Execute("SELECT * FROM [SourceSht$A1:D50]")

obj.Close

End Sub

XXXXXXXXXXX

here...

http://support.microsoft.com/kb/257819

Answer 3

See http://www.vbusers.com/code/codeget.asp?ThreadID=368&PostID=1

Code (written by Andrew Baker) is copied below;

It will update Column A in Sheet 1 with

New Value 1
New Value 2
New Value 3
New Value 4
New Value 5

' The following routine update the contents of an Excel Range using ADO and the JET OLEDB driver.

' An example can be found at the bottom of the post.

Option Explicit

'Purpose   :    Updates the contents of an Excel Spreadsheet using ADO

'Inputs    :    sWorkbookPath               The path of the workbook to update the range contents of.

'               sRange                      The range name or range reference to update (eg. "A1:A20" or "MyRangeName")

'               avNewValues                 A 2d zero based array of values to update the range with.

'               [sWorkSheetName]            The name of the worksheet to update. Only required in not using

'                                           a range name for the sRange variable.

'Outputs   :    Returns zero on success, else returns an error number.

'Author    :    Andrew Baker

'Date      :    1/Aug/2001

'Notes     :    Requires a reference to Microsoft ActiveX Data Objects 2.1 or greater.

'               Uses the OLE DB Provider for Jet.

Function ExcelRangeUpdate( _

            sWorkbookPath As String, _

            sRange As String, _

            avNewValues As Variant, _

            Optional sWorkSheetName As String = "" _

            ) As Boolean

    Dim oConn As ADODB.Connection

    Dim oCmd As ADODB.Command

    Dim oRS As ADODB.Recordset

    Dim lThisRow As Long, lThisCol As Long, bAddedRow As Boolean

    On Error GoTo ErrFailed

    'Open a connection to the Excel spreadsheet

    Set oConn = New ADODB.Connection

    '"HDR=Yes" means that there is a header row in the cell range (or named ranged), so the provider will NOT include the first row (of the selection) into the recordset.

    'If "HDR=No", then the provider will include the first row (of the cell range or named ranged) into the recordset.

    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sWorkbookPath & ";Extended Properties=""Excel 8.0;HDR=No;"""

    'Create a command object and set its ActiveConnection

    Set oCmd = New ADODB.Command

    oCmd.ActiveConnection = oConn

    oCmd.CommandText = "SELECT * from " & sWorkSheetName & "$" & sRange & ""

    'Open a recordset containing the worksheet data.

    Set oRS = New ADODB.Recordset

    oRS.Open oCmd, , adOpenKeyset, adLockOptimistic

    'Update the values in the recordset

    For lThisRow = 0 To UBound(avNewValues, 2)

        For lThisCol = 0 To UBound(avNewValues, 1)

            'Note, you will get a type mismatch if the range

            'already contains a value of a different type. eg.

            'updating a numeric cell with a string value will

            'give you a type mismatch. Get round this be using

            'the .Delete and .Add methods to add a new blank

            'row/cell

            oRS(lThisCol).Value = avNewValues(lThisCol, lThisRow)

            If bAddedRow Then

                oRS.Update

            End If

        Next

        oRS.MoveNext

        If oRS.EOF Then

            'The query only returns rows which have existing values or have

            'values after them. Must call AddNew for all other empty cells.

            oRS.AddNew

            bAddedRow = True

        End If

    Next

    If bAddedRow Then

        oRS.Update

    End If

    'Close the connection

    oRS.Close

    oConn.Close

    Set oRS = Nothing

    Set oCmd = Nothing

    Set oConn = Nothing

    Exit Function

ErrFailed:

    'Failed

    Debug.Print "ExcelRangeUpdate Error: " & Err.Description

    Set oRS = Nothing

    Set oCmd = Nothing

    Set oConn = Nothing

    ExcelRangeUpdate = False

End Function

'Demonstration routine

Sub Test()

    Dim avValues As Variant

    Dim lThisRow As Long

    ReDim avValues(0 To 0, 0 To 19)

    For lThisRow = 0 To 19

        avValues(0, lThisRow) = "New Value " & lThisRow + 1

'        Debug.Print avValues(0, lThisRow)

    Next

 'ExcelRangeUpdate "C:\test.xls", "Sheet1", "A1:A20", avValues

 'Corrected to

    ExcelRangeUpdate ThisWorkbook.Path & "" & ThisWorkbook.Name, "A1:A20", avValues, "Sheet1"

End Sub