Подключение всех таблиц внешней БД (DAO) v014

Public Function LinkAllTables_MSADB_DAO(sSrcDBPath As String, Optional sLocalPrefix$ = "") As Long
' es 11.03.2013: LE 20.06.2024 v014
' Подключение всех таблиц указанного переданной в аргументе базы данных (кроме скрытых и системных)
' При возникновении ошибки возвращает ее код
'---------------------------------------------------------------------------------------------------/
' Аргументы:
'   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%
'---------------------------------------------------------------------------------------------------/
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 & "' AND Type=6") > 0 Then
                Set tdfLocal = dbLocal.TableDefs(sLocalTableName)
                If Not tdfLocal.Connect = sSrcDBConnectionStr Then  'Если путь изменился:
                    tdfLocal.Connect = sSrcDBConnectionStr
                    tdfLocal.RefreshLink
                End If
            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