VBA, MS Access MS Access в примерах

Подключение указанной таблицы определённого MDB файла (DAO)

Private Function AttachTableDAO(sConnectString As String, _
                sSrsTableName As String, _
                Optional sLocalTableName As String = "", _
                Optional bMakeTableHidden As Boolean = False) As Long
'----------------------------------------------------------------------------------------
' es 25.11.04 - 29.01.2021 v003
' Вспомогательная функция подключения конкрктной таблицы по аргументам::
'--------------------------------------------------------------------
'   sConnectString       = строка подключения вида: ";DATABASE=C:\DB.mdb"
'   sSrsTableName        = Исходное название таблицы в базе
'   bMakeTableHidden     = Сделать скрытой (по умолч. = нет)
'   sLocalTableName      = Новое имя таблицы (по умолч. = sSrsTableName)
'При ошибке возвращает ее код
'--------------------------------------------------------------------
Dim db As DAO.Database
Dim tdf As DAO.TableDef, sVal$
'--------------------------------------------------------------------
On Error GoTo AttachTableDAO_Err
    
'Имя создаваемой таблицы
    If sLocalTableName = "" Then sLocalTableName = sSrsTableName
    Set db = CurrentDb()
    
'Удаление старой (если есть)
    If DCount("*", "MSysObjects", "[Name]='" & sLocalTableName & "' AND Type=6") > 0 Then
        'Db.TableDefs.Delete sLocalTableName
        DoCmd.SetWarnings False
        DoCmd.DeleteObject acTable, sLocalTableName
        DoCmd.SetWarnings True
    End If

'Создание и подключение
    Set tdf = db.CreateTableDef(sLocalTableName)
    tdf.Connect = sConnectString
    tdf.SourceTableName = sSrsTableName
    db.TableDefs.Append tdf

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

AttachTableDAO_End:
    On Error Resume Next
    Set tdf = Nothing
    db.Close
    Set db = Nothing
    Err.Clear
    Exit Function

AttachTableDAO_Err:
    AttachTableDAO = Err.Number
    sVal = "Error " & Err.Number & " (" & Err.Description & ") in Function" & _
           "AttachTableDAO - modConnection_DAO."
    'MsgBox sVal, vbCritical, "Произошла ошибка!"
    Debug.Print sVal
    'Debug.Print "AttachTableDAO_Line: " & Erl & "."
    Err.Clear
    Resume AttachTableDAO_End

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