ODBC msquery to pull records from one sheet to another in same workbook 1

[dhookom]

I expect there might be a better method for handling this. I have an Excel 2010 workbook with a worksheet named "Left Right Data". On another worksheet, I have a drop down in range("cbofacGrp") that allows the user to query the records/rows from Left Right Data. The filtered records display on the other worksheet. This all works ok as long as the folder structure is exactly the same. If I move the file to another folder, I must update the connection properties.

I am attempting to use VBA with ThisWorkbook.Path and ThisWorkbook.FullName to update the ODBCConnection properties. When I run the code, I get an error message "Cannot update. Database or object is read-only." and get prompted to browse for the file name. The Excel file is in a trusted location and the code is running. The SwitchODBCSource sub doesn't seem to be updating the connection as expected.

Any ideas how to fix this or is there an alternative?

Sub UpdateData()
    Dim strCommand As String
    Dim strConnection As String
    Dim strFullname As String
    Dim strPath As String
    strPath = ThisWorkbook.Path
    strFullname = ThisWorkbook.FullName
    SwitchODBCSource
    strCommand = "SELECT `'Left Right Data$'`.rfgRFGID, `'Left Right Data$'`.`Factory Group`, `'Left Right Data$'`.kdaYear, " & _
        "`'Left Right Data$'`.kdaMonth, `'Left Right Data$'`.klrKPI, `'Left Right Data$'`.RIndCode, `'Left Right Data$'`.LindCode, " & _
        "`'Left Right Data$'`.LSum, `'Left Right Data$'`.RSum, `'Left Right Data$'`.klrCalc, `'Left Right Data$'`.F11, `'Left Right Data$'`.`AI Calc'd` " & _
        "FROM `" & strFullname & "`.`'Left Right Data$'` `'Left Right Data$'` " & _
        "WHERE (`'Left Right Data$'`.`Factory Group`='" & Range("cboFacGrp") & "') " & _
        "ORDER BY `'Left Right Data$'`.klrKPI, `'Left Right Data$'`.kdaYear, `'Left Right Data$'`.kdaMonth"
    
    ThisWorkbook.Connections(1).ODBCConnection.CommandText = strCommand
    [highlight #FCE94F]ThisWorkbook.Connections(1).Refresh   '<-- error generated[/highlight]
End Sub
Sub SwitchODBCSource()
    Dim conn As WorkbookConnection
    Dim sOldConnection As String, sNewConnection As String
    Dim strPath As String
    Dim strFullname As String
    strPath = ThisWorkbook.Path
    strFullname = ThisWorkbook.FullName
    
    For Each conn In ActiveWorkbook.Connections
        With conn
            conn.ODBCConnection.BackgroundQuery = False
            conn.ODBCConnection.CommandType = xlCmdSql
            conn.ODBCConnection.Connection = Array(Array( _
            "DSN=Excel Files;DBQ=" & strFullname & ";DefaultDir=" _
            ), Array( _
           strPath & ";DriverId=1046;MaxBufferSize=2048;PageTimeout=5;" _
            ))
          End With
    Next conn
    Set conn = Nothing
End Sub

Duane
Hook'D on Access
MS Access MVP

 

[SkipVought]

Duane,

here's a test set to get the connection string

Sub test()
    Dim sPath As String, sDB As String, sConn As String, sSQL As String
    
    sPath = ThisWorkbook.Path
    
    sDB = ThisWorkbook.Name
    
    sConn = ""
    
    
    With ActiveSheet.ListObjects(1).QueryTable
        Debug.Print .Connection
        
    End With
End Sub

Then assign the connection string to sConn, I concatenate on several lines....

Sub test()
    Dim sPath As String, sDB As String, sConn As String, sSQL As String
    
    sPath = ThisWorkbook.Path
    
    sDB = ThisWorkbook.Name
    
    sConn = "ODBC;DSN=Excel Files;"
    sConn = sConn & "DBQ=C:\Users\Skip\Documents\TT_sample.xlsm;"
    sConn = sConn & "DefaultDir=C:\Users\Skip\Documents;"
    sConn = sConn & "DriverId=1046;MaxBufferSize=2048;PageTimeout=5;"
    
    
    With ActiveSheet.ListObjects(1).QueryTable
        Debug.Print .Connection
        
    End With
End Sub

then substitute the path & db variables

Sub test()
    Dim sPath As String, sDB As String, sConn As String, sSQL As String
    
    sPath = ThisWorkbook.Path
    
    sDB = ThisWorkbook.Name
    
    sConn = "ODBC;DSN=Excel Files;"
    sConn = sConn & "DBQ=" & sPath & "\" & sDB & ";"
    sConn = sConn & "DefaultDir=" & sPath & ";"
    sConn = sConn & "DriverId=1046;MaxBufferSize=2048;PageTimeout=5;"
    
    
    With ActiveSheet.ListObjects(1).QueryTable
        .Connection = sConn      'substitute the on-the-fly connection
        .Refresh False
    End With
End Sub

In some cases the path \ db is also part of the FROM clause, in which case you'll also need to reconstruct the SQL string with the variables.

Hope this helps.

 

[dhookom]

Thanks Skip,

I don't believe I would have ever found "ListObjects()". I scoured the web based on the error message and other terms and never once saw this mentioned.

The code seems to work well. I moved the file from one folder to another and the code worked as expected.

Duane
Hook'D on Access
MS Access MVP

 

[SkipVought]

Prior to Excel 2007 there was not a ListObject object. The QueryTable object was added directly to the sheet in the process og working thru the GUI to import external data via Microsoft Query.