DoCmd.CopyObject "ПутьБазыНазначения", _
"НовоеИмяТаблицы", acTable, "ИмяТаблицыИсточника"

Private Sub DOBAVKA_TABLICI_V_MDB(BAZA_NAME As String )
'Добавление таблицы в базу
Dim appAccess As New Access.Application
Dim obj As Object

   If FSO.FileExists(CurrentProject.Path & "\ZAGRUZKI\" & BAZA_NAME) = False Then
   MsgBox " файл " & BAZA_NAME & " не найден"
   Exit Sub
   End If

appAccess.OpenCurrentDatabase (CurrentProject.Path & "\ZAGRUZKI\" & BAZA_NAME)
   
    For Each obj In appAccess.CurrentProject.AllForms
    DoCmd.TransferDatabase acExport, "Microsoft Access", CurrentProject.Path & "\COMPONENTS\TABLICI\" & "OPTION_TBL.mdb", acTable, obj.Name, obj.Name
    Next obj
appAccess.CloseCurrentDatabase
Set appAccess = Nothing

End Sub

кусок переноса файла из сети, поближе к программе

        'Проверка доступности файла
        If FUN_PROVERKA_FILES_V_SETI(FOLDER_ZAGRUZKA & "\" & FILE_NAME) = False Then
            MESS "Сетевой файл не доступен. " & vbCrLf & FOLDER_ZAGRUZKA & "\" & FILE_NAME
            Exit Function
        End If
        STR_PATCH_FILE = FOLDER_ZAGRUZKA & "\" & FILE_NAME
    End If
    ' индикатор
    Form_ZAGRUZKA_VIGRUZKA_KASSIRA_FRM!ZAGRUZAEM_NADPIS.Visible = True

    MESS "Нажмите   ОК " & vbCrLf & "и дождитесь окончания загрузки " & vbCrLf & "Не нажимайте мышку во время загрузки."

' перенос файла из сетевой папки  в папку ZAGRUZKI
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Call FUN_DELETE_FILE_NAME(CurrentProject.Path & "\" & FILE_NAME)
    Call FUN_DELETE_FILE_NAME(CurrentProject.Path & "\ZAGRUZKI\" & FILE_NAME)
    FSO.CopyFile STR_PATCH_FILE, (CurrentProject.Path & "\ZAGRUZKI\" & FILE_NAME)

=============================================

Public Function FUN_PERENOS_TABLIC() As Boolean
' Перенос таблиц в базу из доп файла UPDATES.mdb
    Dim DB_2 As DAO.Database
    Dim tdf As DAO.TableDef

  On Error GoTo FUN_PERENOS_TABLIC_Error
'-----------------------------------------------------------------------------

FUN_PERENOS_TABLIC = False

            TEMP_PATCH_TO_BASE = CurrentProject.Path & "\ZAGRUZKI\UPDATES.mdb"
            Set DB_2 = OpenDatabase(TEMP_PATCH_TO_BASE)   

            For Each tdf In DB_2.TableDefs
                If Mid(tdf.Name, 1, 4) <> "Msys" Then   'если  не системная таблица тогда смотрим
                   FUN_PERENOS_TABLICI_V_MDB (tdf.Name)
                   'присоединим таблицу
                   Call FUN_LINK_TBL(CurrentProject.Path & "\COMPONENTS\TABLICI\OPTION_TBL.mdb", tdf.Name, tdf.Name)
                End If
            Next tdf
            DB_2.Close
            Set DB_2 = Nothing
            
FUN_PERENOS_TABLIC = True

'-----------------------------------------------------------------------------
   On Error GoTo 0
   Exit Function
FUN_PERENOS_TABLIC_Error:


 Call FUN_ZAPIS_V_TEXT_FILE(CurrentProject.Path & "\Ошибки программы.txt", "Функция: FUN_PERENOS_TABLIC в модуле: ZAGRUZKA_MOD" & vbTab & Nz(Err.Description))

End Function

==================================================

Public Function FUN_PERENOS_TABLICI_V_MDB(TABLE_NAME As String)
' Сам перенос таблицы
Dim appAccess As Access.Application
Dim OTKUDA$, KUDA$
    
  On Error GoTo FUN_PERENOS_TABLICI_V_MDB_Error
'-----------------------------------------------------------------------------

    OTKUDA = CurrentProject.Path & "\ZAGRUZKI\UPDATES.mdb"
    KUDA = CurrentProject.Path & "\COMPONENTS\TABLICI\OPTION_TBL.mdb"
    Set appAccess = CreateObject("Access.Application")
    With appAccess
        .OpenCurrentDatabase KUDA
        If TABLE_NAME_YES_NO(TABLE_NAME, KUDA) = True Then
        .DoCmd.DeleteObject acTable, TABLE_NAME
        End If
        .DoCmd.TransferDatabase acImport, "Microsoft Access", OTKUDA, acTable, TABLE_NAME, TABLE_NAME
    End With
   
    Set appAccess = Nothing

'-----------------------------------------------------------------------------
   On Error GoTo 0
   Exit Function
FUN_PERENOS_TABLICI_V_MDB_Error:

 Call FUN_ZAPIS_V_TEXT_FILE(CurrentProject.Path & "\Ошибки программы.txt", "Функция: FUN_PERENOS_TABLICI_V_MDB в модуле: ZAGRUZKA_MOD" & vbTab & Nz(Err.Description))

End Function

=======================================================

Public Function FUN_LINK_TBL(sBasePath As String, _
                srsTblName As String, _
                Optional newTblName As String = "", _
                Optional MakeHidden As Boolean = False) As Long
'es 30.06.2011
'Подключение указанной таблицы MDB файла
'--------------------------------------------------------------------
'Аргументы:
'   sBasePath     = Строка пути вида: "C:\Temp\MyDB.mdb"
'   srsTblName    = Исходное название таблицы в базе
'   newTblName    = Новое имя таблицы (по умолч. = srsTblName)
'   makeHidden    = Сделать скрытой (по умолч. = нет)
'При ошибке возвращает ее код
'--------------------------------------------------------------------
Dim db As DAO.Database
Dim tdf As DAO.TableDef
    
'Имя создаваемой таблицы
    If newTblName = "" Then newTblName = srsTblName
'Удаление старой (если есть)
On Error Resume Next
    Set db = CurrentDb
    db.TableDefs.Delete newTblName
    Err.Clear
'Создание и подключение
On Error GoTo ConnectToTableErr
    Set tdf = db.CreateTableDef(newTblName)
    tdf.Connect = ";DATABASE=" & sBasePath
    tdf.SourceTableName = srsTblName
    db.TableDefs.Append tdf
    db.TableDefs.Refresh
'Если указано что должна быть скрытая
'    If MakeHidden = True Then tdf.Attributes = dbHiddenObject

ConnectToTableBye:
    On Error Resume Next
    Set tdf = Nothing
    db.Close
    Set db = Nothing
    Exit Function

ConnectToTableErr:
    FUN_LINK_TBL = Err.Number
    'Debug.Print Err.Description
    Resume ConnectToTableBye
End Function