Automate response to Run-time error 3146 ODBC--call failed - sql

Question

I have a number of Excel dashboards running in my factory that refresh each minute, by connecting to a local Access Db and running a number of queries.
The Db itself has ODBC connections to a couple of different SQL database tables. They run fine most of the time but I have a problem with random 3146 ODBC--call failed errors popping up.
I have worked with my IT people and have not really been able to nail down the root cause.
I can click OK on the error popup and the dashboard may refresh fine for anther day or more or it may pop the 3146 error again 10 minutes later. There does not seem to be any real consistency to it.
I have read several posts about missing primary keys in the linked tables as to root cause. That may be true here as well but unfortunately these tables are from a third party vendor and I cannot modify them without creating issues with their software functionality.
Short of an actually fix for the root cause, I am wondering if there is a way through my VBA that I can automate clicking the OK button on the 3146 error popup so that this error is automatically acknowledged and the dashboard can go on about it's business.

Answer 1

One way to handle the situation is to trap the error. I can only suggest a general approach, one that I use in similar situations. Without knowing more about your app, it is hard to be very specific. This answer assumes you are using ADO to connect to Access, and pulling back a Recordset to populate the Dashboard. It further assumes you are not trapping errors currently. Here is a template to illustrate the idea:
Public Sub Dashboard()
On Error GoTo error
Dim e As ADODB.error
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = "however you are connecting"
Set rs = "however you are retrieving data" 'assuming an error with this line
Do While Not rs.EOF
rs.MoveNext
Loop
cleanup:
'any code that always has to happen
Exit Sub
error:
If Err.Number = 3146 Then
'do nothing and continue where you left off
Resume Next
End If
'possibly check connection errors, too
For Each e In cn.Errors
If e.Number = 3146 Then
'do nothing and continue where you left off
Resume Next
End If
Next
'show error and exit sub (which is what it is doing now)
MsgBox Err.Description
Resume cleanup
End Sub
Here's another option if you don't care to catch a specific error:
Public Sub Dashboard()
Dim rs As ADODB.Recordset
On Error Resume Next
Set rs = "however you are retrieving data" 'assuming an error with this line
On Error GoTo 0
Do While Not rs.EOF
rs.MoveNext
Loop
End Sub