MyTetra Share
Делитесь знаниями!
Проверка качества подключения таблиц
19.07.2018
06:37
Раздел: VBA - Access - msa.polarcom.ru - 02 Внешние Данные

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

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





 
MyTetra Share v.0.52
Яндекс индекс цитирования