Excel VBA -- Run-time error '-2147417848 (80010108)': Method 'Refresh' of object 'WorkbookConnection' failed

[jpmccreary]

I am getting this error on a workbook connections refresh that is done in VBA. I am using Excel Professional Plus 2010 and Windows 7. The code is part of a complex workbook that has 20 sheets, 330 procedures and 8,326 lines of code. The module with the error modifies a connection to an Access database that contains customer information. The connection queries the database and retrieves all data for the customer being queried. Complete module below.

The error does not occur every time the code runs. I have not found a pattern for when it works and when it does not work. On the Microsoft support site I did find the error code description: The object invoked has disconnected from its clients. Here is the incredibly odd thing. The query does complete, at least as far as I can see. All fields get updated. After the error, Excel begins to behave strangely. Selected cells are not highlighted and the formula bar does not update when clicking new cells (even though I can tell that cells are selected because I can enter new values in them). The name box is empty until I click into it. It also appears that VBA does not recognize when a cell is selected because all code that tries to select or change a cell errors out. I can change tabs, save and perform many other Excel actions. This strange behavior continues until I close Excel completely. When I re-open the workbook everything is fine. The tool is used by others, and they experience the same issues that I see, so it isn't just my computer. I was looking for code that would close the connection between Excel and the Access database but couldn't find anything. Not sure if that would help solve the issue or not.

 </SPAN>
Sub Get_Customer_Data()
    Dim sWorkbookName As String
    Dim sMCN As String
    Dim sCommandText As String
    Dim sConnection As String
   
    ActiveWorkbook.Unprotect Password:=Range("Password")
    Unlock_Sheet ("FA QUERY") 'sheet where connection exists
   
    sWorkbookName = ActiveWorkbook.Name
    sMCN = Range("Master Customer Number")
   
    DoEvents
    Application.StatusBar = "Searching for customer data . . . "</SPAN>
'***DATA FOR QUERY
    sCommandText = "SELECT `Data Sheet`.`Plan ID`, `Data Sheet`.`Plan Type`, `Data Sheet`.`Plan Description`, `Data Sheet`.Status, `Data Sheet`.`Customer #`, "
    sCommandText = sCommandText & "`Data Sheet`.`Tier 1 Lower`, `Data Sheet`.`Tier 1 Upper`, `Data Sheet`.`Tier 1 Rate`"
    sCommandText = sCommandText & Chr(13) & "" & Chr(10)
'***FILE LOCATION
    sCommandText = sCommandText & "FROM `\\drive2\Dept\SALES\FILES\DATABASE\Customer Database.accdb`.`Data Sheet` `Data Sheet`"
    sCommandText = sCommandText & Chr(13) & "" & Chr(10)
'***QUERY FILTERS
    sCommandText = sCommandText & "WHERE (`Data Sheet`.`Customer #`=" & sMCN & ")  AND (`Data Sheet`.Status<>'DISCARDED')"
    sCommandText = sCommandText & Chr(13) & "" & Chr(10)
'***QUERY SORT
    sCommandText = sCommandText & "ORDER BY `Data Sheet`.`Plan Description`, `Data Sheet`.Status DESC"
   
    sConnection = "ODBC;DSN=MS Access Database;"
    sConnection = sConnection & "DBQ=\\drive2\Dept\SALES\FILES\DATABASE\Customer Database.accdb;"
    
    With ActiveWorkbook.Connections("Customer Database.accdb Data Sheet").ODBCConnection
        .BackgroundQuery = False
        .CommandType = xlCmdSql
        .CommandText = sCommandText
        .Connection = sConnection
        .RefreshOnFileOpen = False
        .SavePassword = False
        .SourceConnectionFile = ""
        .SourceDataFile = ""
        .ServerCredentialsMethod = xlCredentialsMethodNone
        .AlwaysUseConnectionFile = False
    End With
   
'***ERROR OCCURS HERE
    Application.Workbooks(sWorkbookName).Connections("Customer Database.accdb Data Sheet").Refresh
'******************
    Range("Verify") = False</SPAN>
Error_Handler:
    Application.StatusBar = False
    ActiveWorkbook.Protect Password:=Range("Password")</SPAN>
End Sub</SPAN>

Thanks in advance for any help. This has been going on for a while and I am incredibly frustrated at this point.</SPAN>

 

[andrewkard]

Hello, from Help: ActiveWorkbook.Connections(1).ODBCConnection.Refresh

 

[Andrew Poulsom]

Have you tried removing that line and putting .Refresh before End With?

 

[jpmccreary]

Moving the Refresh inside the with statement seems to have resolved the issue. Odd, because the macro recording gave me the refresh outside the with statement so I assumed that would be ok, although I had considered moving it when re-writing. Thanks to both Andrews for responding.