Update Embedded Query using VBA

[tonycuban]

This was a request from my boss and i can't get it to work properly

The workbook have multiple worksheets. Most of the worksheets have embedded queries from A MS Access database. The intention is to update all the embedded queries by clicking on a button if the location of the database were to change.
I wrote the following

Private Sub cmd_Update_Qry_Click()
On Error GoTo cmd_Update_Qry_Err
Application.EnableCancelKey = xlDisabled

strDbPath = Range("DbPathFolder").Value
strOldDbPath = Range("DbOldPathFolder").Value

For Each oworkSheet In ThisWorkbook.Worksheets

If oworkSheet.QueryTables.Count <> 0 Then

strWorksheetName = oworkSheet.Name

For Each qt In oworkSheet.QueryTables
strQryName = qt.Name
strSQL = qt.CommandText
strConnection = qt.Connection

strConnection = Application.WorksheetFunction.Substitute(strConnection, strOldDbPath, strDbPath)

strSQL = Application.WorksheetFunction.Substitute(strSQL, strOldDbPath, strDbPath)

Set qtConnection = ThisWorkbook.Worksheets(strWorksheetName).QueryTables(strQryName)
qtConnection.Connection = strConnection
qtConnection.CommandText = strSQL
Next qt
End If
Next

Set qt = Nothing
Set qtConnection = Nothing
MsgBox "Done!"

Exit Sub

cmd_Update_Qry_Err:
Select Case Err.Number
Case 1004
Resume Next
Case Else
End Select

End Sub

Problem #1
Sometimes the SQL doesn't get updated on any of the worksheets. Sometimes some get updated and some don't.
It never, not even once, updated all the worksheets

Problem #2
If the SQL gets updated, when the data is refresh it works but:
when try to see the SQL by going Data - Import External Data - Edit Query I get the message "[Microsoft][ODBC Microsoft Access Driver] Record is deleted."

Thanks for your time

 

[Andrew Poulsom]

Your code doesn't use the QueryTable's Refresh method to update the Connection and retrieve the data.

 

[tonycuban]

Thanks for your reply Andrew.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I added line <o></o>
qtConnection.Refresh<o></o>
after<o></o>
Set qtConnection = ThisWorkbook.Worksheets(strWorksheetName).QueryTables(strQryName)
qtConnection.Connection = strConnection
qtConnection.CommandText = strSQL<o></o>
<o></o>
both problems remain.<o></o>
#1: The workbook has 15 worksheet. It updates the sql in the first worksheet, skips worksheet 2 to 4, and updates the rest.<o></o>
<o></o>
#2: The worksheets were the SQL is updated, when try to see the SQL by going Data - Import External Data - Edit Query I get the message "[Microsoft][ODBC Microsoft Access Driver] Record is deleted."<o></o>

 

[Andrew Poulsom]

What is the setting for the QueryTables' BackgroundQuery property?

 

[tonycuban]

I don’t understand your question.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
The background query is strQryName<o></o>
<o> </o>
Set qtConnection = ThisWorkbook.Worksheets(strWorksheetName).QueryTables(strQryName)<o></o>
<o> </o>
And strQryName gets set in:
<o> </o>
If oworkSheet.QueryTables.Count <> 0 Then<o></o>
<o></o>
strWorksheetName = oworkSheet.Name<o></o>
<o></o>
For Each qt In oworkSheet.QueryTables<o></o>
strQryName = qt.Name
Thanks

 

[Andrew Poulsom]

No, the BackgroundQuery property can be True or False. If True queries are performed asynchronously (in the background).

 

[tonycuban]

i checked the external Data range Properties and the background refresh is enabled

i did try the code both way, with the same result
qtConnection.Refresh True
qtConnection.Refresh False

Is there is anything I should add to my original code beside qt.Connection.Refresh True

Thanks

 

[Andrew Poulsom]

Is there is anything I should add to my original code beside qt.Connection.Refresh True

Not that I can think of. If BackgroundQuery is Dalse the macro should wait until it's finished before moving on.

Why are you doing this:

Set qtConnection = ThisWorkbook.Worksheets(strWorksheetName).QueryTables(strQryName)
qtConnection.Connection = strConnection
qtConnection.CommandText = strSQL

rather than?

qt.Connection = strConnection
qt.CommandText = strSQL

 

[tonycuban]

Thanks.
I changed it as per your suggestion

We found the problems !!!!
Problem #1 - The Substitute function is case sensitive and the database old path in some of the SQLs where lower case, so, before running the substitute function i use the UCASE function to ensure that the string searched is found

Problem #2 - The new database needed to be "compacted and repaired"

For any one who may need the code here is again after been fixed:

Private Sub cmd_Update_Qry_Click()
On Error GoTo cmd_Update_Qry_Err
Application.EnableCancelKey = xlDisabled

strDbPath = Range("DbPathFolder").Value
strOldDbPath = UCase(Range("DbOldPathFolder").Value)

If strDbPath = "" Or strOldDbPath = "" Then Exit Sub

For Each oworkSheet In ThisWorkbook.Worksheets

If oworkSheet.QueryTables.Count <> 0 Then

strWorksheetName = oworkSheet.Name

For Each qt In oworkSheet.QueryTables
strQryName = qt.Name
strSQL = UCase(qt.CommandText)
strConnection = UCase(qt.Connection)

strConnection = Application.WorksheetFunction.Substitute(strConnection, strOldDbPath, strDbPath)

strSQL = Application.WorksheetFunction.Substitute(strSQL, strOldDbPath, strDbPath)

qt.Connection = strConnection
qt.CommandText = strSQL
qt.Refresh False
Next qt
End If
Next

Range("DbOldPathFolder").Value = strDbPath
Range("DbPathFolder").Select
Selection.ClearContents

Set qt = Nothing
Set qtConnection = Nothing

MsgBox "Done!"

cmd_Update_Qry_Exit:
Exit Sub
cmd_Update_Qry_Err:
MsgBox Err.Number & " " & Err.Description
GoTo cmd_Update_Qry_Exit
End Sub