Option Compare Database
Option Explicit
Function CopiaTabla_desdeDB1_DeDB2_aDB3()

On Error GoTo errRollback
Dim dbs As New Access.Application
  
  DesprotejeBase "C:\Ruta\Dsystem.Mdb"
  dbs.OpenCurrentDatabase "C:\Ruta\Dsystem.Mdb", False
 
  dbs.DoCmd.CopyObject "C:\Ruta\Datos.Mdb", , acTable, "PersonalizacionInterna"
  dbs.CloseCurrentDatabase
  Set dbs = Nothing
  ProtejeBase "C:\Ruta\Dsystem.Mdb"
  
  Exit Function
errRollback:
 MsgBox Err.Number & " " & Err.Description
   
End Function


'=====================================
Sub DesprotejeBase(Base As String)
 On Error GoTo Err_Comando2_Click
 Dim WrkJeT As Workspace
 Dim dbs As Database
 Set WrkJeT = CreateWorkspace("", "admin", "", dbUseJet)
 Set dbs = WrkJeT.OpenDatabase(Base, True, False, ";PWD=330086")
 dbs.NewPassword "330086", ""
 dbs.Close
 Set dbs = Nothing
 WrkJeT.Close
 Set WrkJeT = Nothing
 Exit Sub
 
Exit_Comando2_Click:
    Exit Sub

Err_Comando2_Click:
 MsgBox "Error Nš: " & Err.Number & ", " & Err.Description, vbCritical, "ERROR COPIA TABLA"
 Resume Exit_Comando2_Click
End Sub


'========================================
Sub ProtejeBase(Base As String)
 On Error GoTo Err_Comando2_Click
 Dim WrkJeT As Workspace
 Dim dbs As Database
 Set WrkJeT = CreateWorkspace("", "admin", "", dbUseJet)
 Set dbs = WrkJeT.OpenDatabase(Base, True, False, ";PWD=")
 dbs.NewPassword "", "330086"
 dbs.Close
 Set dbs = Nothing
 WrkJeT.Close
 Set WrkJeT = Nothing
 Exit Sub
 
Exit_Comando2_Click:
    Exit Sub

Err_Comando2_Click:
 MsgBox "Error Nš: " & Err.Number & ", " & Err.Description, vbCritical, "ERROR COPIA TABLA"
 Resume Exit_Comando2_Click
End Sub