'Bhuo Agosto de 2002
'*Otra  forma de copiar tablas.
'Este caso es particularmente util pues hace lo siguiente:
'Este codigo se ejecuta desde MDB1 y lo que hace es copiar
'una tabla de una MDB2 a otra MDB3
'Yo creo que es el unico caso que resta por contemplar.
'Ademas, para ilustrar el ejemplo, la base "C:\TwPac\Dsystem.Mdb"
'esta protegida por contraseņa. Para realizar el proceso, es necesario
'antes de copiar la tabla, quitar la contraseņa de proteccion
'y una vez realizada la copia, volverla a ponerla como estaba.

Option Compare Database
Option Explicit
Function CopiaTabla_desdeDB1_DeDB2_aDB3()

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

Sub DesprotejeBase(Base As String)
 On Error GoTo Err_Comando2_Click
 Dim WrkJeT As Workspace, Sql As String, Rst As Recordset
 Dim dbs As Database
 Set WrkJeT = CreateWorkspace("", "admin", "", dbUseJet)
 Set dbs = WrkJeT.OpenDatabase(Base, True, False, ";PWD=Contraseņa")

 dbs.NewPassword "Contraseņa", ""
 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, Sql As String, Rst As Recordset
 Dim dbs As Database
 Set WrkJeT = CreateWorkspace("", "admin", "", dbUseJet)
 Set dbs = WrkJeT.OpenDatabase(Base, True, False, ";PWD=")
 dbs.NewPassword "", "Contraseņa"
 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 TABLAS"
 Resume Exit_Comando2_Click
End Sub