Public Sub CreateTempDB_DAO(Optional TempFileName As String = "TempDB.accdb")
'es - 28.09.2012 - 29.01.2021 v004
'--------------------------------------------------------------------
'Создает временную базу данных (MSA-2000-2003) в тек. папке приложения ,
' копирует туда эталонные таблицы  и подключает эти таблицы
'ПАРАМЕТРЫ ВЕРСИИ БД:
'    dbVersion20  - MSA-2
'    dbVersion30  - MSA-97 (compatible with version 3.5).
'    dbVersion40  - MSA-2000-2003
'    dbVersion120 - MSA-2007-2010
'--------------------------------------------------------------------
Dim TempDBPath As String
Dim db As DAO.Database
Dim strDBaseLink As String
Dim l As Long
Dim sTableNameTempalete$, sTableNameLocal$

On Error GoTo CreateTempDB_DAO_Err
'Получаем путь к создаваемой базе
    TempDBPath = CurrentProject.Path & "\" & TempFileName
        
'Сначала удаляем старую (If present)
    If Dir(TempDBPath) <> "" Then
        'On Error Resume Next
        Kill TempDBPath
        DoEvents
        Err.Clear
    End If

'Создаем базу версии MSA-2007
    Set db = DBEngine.CreateDatabase(TempDBPath, dbLangCyrillic, dbVersion120)
    strDBaseLink = ";DATABASE=" & TempDBPath


' Создадим таблицу во временной базе путем копирования эталонной
'01 = 00tp_TabelFromExcel
    sTableNameTempalete = "00tp_TabelFromExcel"
        sTableNameLocal = Mid(sTableNameTempalete, 3)
        DoCmd.CopyObject TempDBPath, sTableNameLocal, acTable, sTableNameTempalete
    'Присоединим созданную таблицу к текущей базе
    l = AttachTableDAO(strDBaseLink, sTableNameLocal)


'--------------------------------------------------------------------------
'Готово!
    'Обновляем список таблиц тек. базы (не обязательно)
    Application.RefreshDatabaseWindow

CreateTempDB_DAO_Bye:
    On Error Resume Next
    db.Close
    Set db = Nothing
    Err.Clear
    Exit Sub

CreateTempDB_DAO_Err:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure CreateTempDB_DAO", vbCritical, "Error!"
    Resume CreateTempDB_DAO_Bye
    
End Sub

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