Подключение всех таблиц внешней БД (DAO) v011 + Error Handler ON|OFF (+ Пример)

'---------------------------------------------------------------------------------------------------/
' modConnectionDAO - Подключение всех таблиц указанного файла БД (DAO)
Private Const blnErrHandlerIsON As Boolean = True ' |False

Public Function LinkAllTables_MSADB_DAO(sSrcDBPath As String, Optional sLocalPrefix$ = "") As Long
'es 11.03.2013: LE 13.05.2023 v011
'Подключение всех таблиц указанного переданной в аргументе базы данных (кроме скрытых и системных)
'---------------------------------------------------------------------------------------------------/
'Аргументы:
'   sSrcDBPath           = Полный путь к БД откуда подключаем таблицы
'   sLocalPrefix         = Префикс местного названия таблицы - добавляется слева от изсходного названия
'Функция при возникновении ошибки возвращает ее код
'---------------------------------------------------------------------------------------------------/
Dim dbSrc As DAO.Database, tdfSrc As DAO.TableDef
Dim dbLocal As DAO.Database, tdfLocal As DAO.TableDef
Dim sSrcDBConnectionStr$, sSrcTableName$, sLocalTableName$ 'Строка подключения и имена таблиц
Dim iConut%
'---------------------------------------------------------------------------------------------------/
' См. выше : Private Const blnErrHandlerIsON As Boolean = True |False
If blnErrHandlerIsON Then On Error GoTo LinkAllTables_MSADB_DAO_Err

    
    Set dbLocal = CurrentDb                           ' Ссылка на текущую  базу MS Access
    Set dbSrc = DBEngine.OpenDatabase(sSrcDBPath)     ' Ссылка на БД источник
    sSrcDBConnectionStr = ";DATABASE=" & sSrcDBPath   ' Строка подключения таблиц (DAO)
    
    For Each tdfSrc In dbSrc.TableDefs      ' Перебор всех таблиц во временной  базе
        If tdfSrc.Attributes = 0 Then       ' Если не скрытая и не системная = подключаем ...
            sSrcTableName = tdfSrc.Name                    ' Исходное имя таблицы
            sLocalTableName = sLocalPrefix & sSrcTableName ' Локальное имя таблицы
            
            ' Проверка наличия старой - ренее подключеной таблицы (если есть переподключение)
            If DCount("*", "MSysObjects", "[Name]='" & sLocalTableName & "'") > 0 Then
                Set tdfLocal = dbLocal.TableDefs(sLocalTableName)
                tdfLocal.Connect = sSrcDBConnectionStr
                tdfLocal.RefreshLink
            Else
                ' Создание обьекта таблица и её подключение к текущей БД:
                Set tdfLocal = dbLocal.CreateTableDef(sLocalTableName)
                tdfLocal.Connect = sSrcDBConnectionStr
                tdfLocal.SourceTableName = sSrcTableName
                CurrentDb.TableDefs.Append tdfLocal
            End If
            iConut = iConut + 1
        End If
        
    Next tdfSrc
    
    If iConut > 0 Then _
        MsgBox "Все таблицы файла:" & vbCrLf & sSrcDBPath & vbCrLf & _
            "Подключены в кол-ве: " & iConut & "шт.", vbInformation, "Подключение Таблиц"
    
LinkAllTables_MSADB_DAO_Bye:
    On Error Resume Next
    Set tdfSrc = Nothing: dbSrc.Close: Set dbSrc = Nothing
    Set tdfLocal = Nothing: dbLocal.Close: Set dbLocal = Nothing
    Err.Clear
    Exit Function

LinkAllTables_MSADB_DAO_Err:
    LinkAllTables_MSADB_DAO = Err.Number
    Debug.Print "LinkAllTables_MSADB_DAO - Err on sSrcTableName:" & sSrcTableName
    Resume LinkAllTables_MSADB_DAO_Bye
End Function

Public Sub DelConnectedTables()
'Удаляет из базы все подключенные таблицы
'---------------------------------------------------------------------------------------------------/
Dim tbl As DAO.TableDef
Dim strPath As String

' См. выше : Private Const blnErrHandlerIsON As Boolean = True |False
If blnErrHandlerIsON Then On Error GoTo DelConnectedTablesErr
    For Each tbl In CurrentDb.TableDefs
        If tbl.Connect <> "" Then  'проверка на строку подключения
            'Табличка подключенная - удаляем
            CurrentDb.TableDefs.Delete tbl.Name
        End If
    Next
'Обновление Области Навигации (Navigation Pane)
    CurrentDb.TableDefs.Refresh  'Обновляем список таблиц[/REM]
    Application.RefreshDatabaseWindow
    DoEvents
    
    MsgBox "Все внешние таблицы успешно отключены.", vbInformation, "Пока!"

DelConnectedTablesBye:
    On Error Resume Next
    Set tbl = Nothing
    Err.Clear
    Exit Sub

DelConnectedTablesErr:
    MsgBox "Произошла ошибка при удалении подключенных таблиц:" & vbCrLf & _
    Err.Description, vbCritical
    Resume DelConnectedTablesBye
End Sub

Private Sub DelTable(sTableName As String)
'Удаляет из базы таблицу по имени переданом в аргументе
'---------------------------------------------------------------------------------------------------/
On Error Resume Next
    CurrentDb.TableDefs.Delete sTableName
    Err.Clear
End Sub

Пример:
    По умолчанию приложение ищет данные в фиксированной подпапке относительно себя (в данном случае подпапка: "DATA"), если не находит, то запрашивает новый путь и запоминает его для будущего использования.

MSA-2007 и выше ( 184 kB) Пример