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
               (
geocities.com/es/ensolva/Descargas)                   (
geocities.com/es/ensolva)                   (
geocities.com/es)