Программное создание базы данных (временной) - CreateTempDb (DAO)

Public Sub CreateTempDb(Optional TempFileName As String = "TempDB.accdb")
'es - 28.09.2012 : v003 : LE - 12.07.2018
'--------------------------------------------------------------------
'Создает временную базу данных (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_Err
'Получаем путь к создаваемой базе
    TempDBPath = CurrentProject.Path & "\" & TempFileName
    'MkDir CurrentProject.Path & scDataSubFolder  'Тут не нужно
        
'Сначала удаляем старую (If present)
    If Dir(TempDBPath) <> "" Then
        Kill TempDBPath
        DoEvents
        Err.Clear
    End If

'Создаем базу версии MSA-2007-2010
    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
    'Линковка таблицы к текущей базе
    DoCmd.TransferDatabase acLink, "Microsoft Access", TempDBPath, _
        acTable, sTableNameLocal, sTableNameLocal

'02 = 00tp_...
    sTableNameTempalete = "00tp_..."
    sTableNameLocal = Mid(sTableNameTempalete, 3)
    DoCmd.CopyObject TempDBPath, sTableNameLocal, acTable, sTableNameTempalete
    'Линковка таблицы к текущей базе
    DoCmd.TransferDatabase acLink, "Microsoft Access", TempDBPath, _
        acTable, sTableNameLocal, sTableNameLocal

'Готово!
'Обновление Области Навигации (Navigation Pane)
    CurrentDb.TableDefs.Refresh [REM]'Обновляем список таблиц
    Application.RefreshDatabaseWindow
    DoEvents

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

CreateTempDb_Err:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure CreateTempDb", vbCritical, "Error!"
    Resume CreateTempDb_Bye
    
End Sub