Sub Create_tmp_mdb()
    On Error GoTo Err_1
    
    Dim db As DAO.Database   ' (объект) MicroSoft DAO 3.51 Object Library
    Dim tb As DAO.TableDef
    Dim FD As DAO.Field
    
    If TableExist("ТаблицаВременная") = True Then
        DoCmd.DeleteObject acTable, "ТаблицаВременная"
    End If
    
    Dim fl As FileSystemObject  ' (объект) MicroSoft Scripting Runtime
    Set fl = New FileSystemObject

    Dim tmp_mdb As String:  tmp_mdb = Environ("Temp") & "\tmp1"
    
    If fl.FileExists(tmp_mdb & ".mdb") Then
       fl.DeleteFile tmp_mdb & ".mdb", True
    End If
    
    Set fl = Nothing
    
    Set db = DBEngine.CreateDatabase(tmp_mdb, dbLangCyrillic)

    Set tb = db.CreateTableDef("ТаблицаВременная")
    Set FD = tb.CreateField("pole1", dbText,  10 ):       tb.Fields.Append FD
    Set FD = tb.CreateField("pole2", dbDouble,  16 ):     tb.Fields.Append FD
    db.TableDefs.Append tb
    db.Close
    
    Set tb = Nothing
    Set FD = Nothing
    Set db = Nothing

    DoCmd.TransferDatabase acLink, "Microsoft Access", tmp_mdb & ".mdb", acTable, "ТаблицаВременная", "ТаблицаВременная"
    
    Exit Sub
    
Err_1:
    MsgBox Err.Description
    Set fl = Nothing
    Set db = Nothing
End Sub

Function TableExist(ByVal TableName As String) As Boolean
    Dim i
    TableName = LCase(TableName)
    For i =  0  To Application.CurrentData.AllTables.Count -  1 
        If LCase(Application.CurrentData.AllTables.Item(i).Name) = TableName Then
            TableExist = True
            Exit For
        End If
    Next i
End Function

Public Sub Create_tmp_mdb()
    On Error GoTo Err_1
    
    Dim db As DAO.Database      ' (объект) MicroSoft DAO 3.51 Object Library
    Dim tb As DAO.TableDef
    Dim FD As DAO.Field
    
    Dim fl As FileSystemObject  ' (объект) MicroSoft Scripting Runtime
    Set fl = New FileSystemObject

    Dim tmp_mdb As String:  tmp_mdb = Environ("Temp") & "\tmp1"
    
    If fl.FileExists(tmp_mdb & ".mdb") Then
       fl.DeleteFile tmp_mdb & ".mdb", True
    End If
    Set fl = Nothing
    
    Dim table_tmp As String:    table_tmp = "ТаблицаВременная"
    
    Set db = CurrentDb()
    On Error Resume Next
    db.TableDefs.Delete table_tmp
    db.Close:    Set db = Nothing
    
    On Error GoTo Err_1
    
    Set db = DBEngine.CreateDatabase(tmp_mdb, dbLangCyrillic)

    Set tb = db.CreateTableDef(table_tmp)
    Set FD = tb.CreateField("pole1", dbText,  10 ):       tb.Fields.Append FD
    Set FD = tb.CreateField("pole2", dbDouble,  16 ):     tb.Fields.Append FD
    db.TableDefs.Append tb
    db.Close
    
    Set tb = Nothing
    Set FD = Nothing
    Set db = Nothing

'    DoCmd.TransferDatabase acLink, "Microsoft Access", tmp_mdb & ".mdb", acTable, "ТаблицаВременная", "ТаблицаВременная"
    
    Set db = CurrentDb
    Set tb = db.CreateTableDef(table_tmp)
    tb.Connect = ";DATABASE=" & tmp_mdb
    tb.SourceTableName = table_tmp
    db.TableDefs.Append tb
    db.Close
    Set tb = Nothing
    Set db = Nothing
    
    Exit Sub
    
Err_1:
    MsgBox Err.Description
    Set fl = Nothing
    Set db = Nothing
End Sub

Private Sub Command1_Click()
    Dim mdb As String:  mdb = Environ("Temp") & "\tmp1.mdb"
    Dim fl As FileSystemObject      ' (объект) MicroSoft Scripting Runtime
    Set fl = New FileSystemObject
    If Not fl.FileExists(mdb) Then
        Dim DB As ADOX.Catalog      ' (объект) Microsoft ADO Ext. 2.7 for DDL and Security
        Dim TB As ADOX.Table
        Set DB = New ADOX.Catalog:  DB.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & mdb & ";"
        Set TB = New ADOX.Table
        TB.Name = "Таблица1"
        TB.Columns.Append "pole1", adVarWChar,  15 
        TB.Columns.Append "pole2", adWChar,  10 
        DB.Tables.Append TB
        Set TB = Nothing
        Set DB = Nothing
    End If
End Sub