Проверка качества подключения таблиц (DAO)

Private Function CheckConnectedTables() As Boolean
'es 18.01.04
'Проверка качества подключения всех подключенных таблиц
'Возвращает True если проверка прошла успешно
'===============================================================
Dim tbl As TableDef
Dim rst As Recordset
On Error GoTo CheckConnectedTablesErr
    For Each tbl In CurrentDb.TableDefs
        If tbl.Connect <> "" Then
            Set rst = CurrentDb.OpenRecordset(tbl.Name, dbOpenDynaset)
        End If
    Next
    CheckConnectedTables = True

CheckConnectedTablesBye:
    On Error Resume Next
    Set tbl = Nothing
    rst.Close
    Set rst = Nothing
    Exit Function
    
CheckConnectedTablesErr:
'Сообщение не обязательно т.к. функция вернет - FALSE
    'MsgBox "Функция [CheckConnectedTables] привела к ошибке:" & vbCrLf & _
    'Err.Description & vbCrLf & " Err#" & Err.Number, vbCritical
    Resume CheckConnectedTablesBye
End Function

Ещё вариант:

Function IsTableOK(sTableName As String) As Boolean
'es 19.12.2017
'Проверка качества соединени с Одной табличкой
Dim objField As Field
On Error GoTo IsFieldPresentErr
    Set objField = CurrentDb.TableDefs(sTableName).Fields(0)
    IsTableOK = True 'Таблица в порядке!
Exit Function

IsFieldPresentErr:
    Err.Clear
End Function

Примечание от Владимира Суханова:
      Проверку качества подключения можно осуществить и не открывая таблицы. Для этого достаточно (у связанных таблиц естественно) проверить значение свойства Tabledefs("Таблица").Fields.Count - если оно равно 0, значит таблица привязана не по тому адресу.
Т.е. функция будет уже такой:

Private Function CheckConnectedTables2() As Boolean
'Проверка качества подключения всех подключенных таблиц
'Возвращает True если проверка прошла успешно
'===============================================================
Dim tbl As TableDef
On Error GoTo CheckConnectedTablesErr
    For Each tbl In CurrentDb.TableDefs
        If tbl.Connect <> "" Then
            If tbl.Fields.Count = 0 Then GoTo CheckConnectedTablesBye
        End If
    Next
    
'Проверка прошла
    CheckConnectedTables2 = True

CheckConnectedTablesBye:
    On Error Resume Next
    Set tbl = Nothing
    Exit Function
    
CheckConnectedTablesErr:
'Сообщение не обязательно т.к. функция вернет - FALSE
    'MsgBox "Функция [CheckConnectedTables] привела к ошибке:" & vbCrLf & _
    Err.Description & vbCrLf & " Err#" & Err.Number, vbCritical
    Resume CheckConnectedTablesBye
End Function