TopPicLogo TopPicText

Подключение всех таблиц указанного файла MDB (DAO)

Public Function esConnectAllTables(ByRef strFilePath As String, Optional ByRef strPrefix As String = "") As Long
'es 11.03.2013
'Подключение всех таблиц указанного файла MDB (кроме скрытых и системных)
'Аргументы:
'   strFilePath = Путь к файлу
'   strPrefix   = Префикс местного названия таблицы
'Функция при возникновении ошибки возвращает ее код
'--------------------------------------------------------------------
Dim strLink As String
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim x As Long

On Error GoTo ConnectAllTablesErr
    Set db = DBEngine.OpenDatabase(strFilePath)
    strLink = ";DATABASE=" & strFilePath
    For Each tdf In db.TableDefs      'Перебор всех таблиц в указанной базе
        If tdf.Attributes = 0 Then    'Если не скрытая и не системная = подключаем ... 
            x = esConnectToTable(strLink, tdf.name, strPrefix & tdf.name)
            If x <> 0 Then 'Если ошибка = На ВЫХОД!
                esConnectAllTables = x
                Exit For
            End If
         End If
    Next tdf
    CurrentDb.TableDefs.Refresh
    esConnectAllTables = x
    
ConnectAllTablesBye:
    On Error Resume Next
    db.Close
    Set db = Nothing
    Err.Clear
    DoEvents
    Exit Function

ConnectAllTablesErr:
    esConnectAllTables = Err.Number
    'Debug.Print Err.Description
    Resume ConnectAllTablesBye
End Function


Public Function esConnectToTable(strBaseLink As String, _
                sourseName As String, _
                Optional newName As String = "", _
                Optional makeHidden As Boolean = False) As Long
'es 25.11.04
'Подключение указанной таблицы по аргументам:
'   strBaseLink     = строка подключения вида: ";DATABASE=C:\DB.mdb"
'   sourseName      = Исходное название таблицы в базе
'   makeHidden      = Сделать скрытой (по умолч. = нет)
'   newName         = Новое имя таблицы (по умолч. = sourseName)
'При ошибке возвращает ее код
'--------------------------------------------------------------------
Dim db As DAO.Database
Dim tdf As DAO.TableDef
    
'Имя создаваемой таблицы
    If newName = "" Then newName = sourseName
'Удаление старой (если есть)
    On Error Resume Next
    Set db = CurrentDb
    db.TableDefs.Delete newName
    Err.Clear
'Создание и подключение
On Error GoTo ConnectToTableErr
    Set tdf = db.CreateTableDef(newName)
    tdf.Connect = strBaseLink
    tdf.SourceTableName = sourseName
    db.TableDefs.Append tdf

'если указано что должна быть скрытая
    If makeHidden = True Then
        Application.SetHiddenAttribute acTable, tdf.Name, True
    End If

ConnectToTableBye:
    On Error Resume Next
    Set tdf = Nothing
    Set db = Nothing
    Err.Clear
    Exit Function
ConnectToTableErr:
    esConnectToTable = Err.Number
    'Debug.Print Err.Description
    Resume ConnectToTableBye
End Function



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

Picture

Picture




Скачать

MSA-2003 ( 138 kB) Пример


Назад ToTop
L.E. 25.08.2017
Рейтинг@Mail.ru