'Bhuo Agosto 2002
'Estas funciones sirven para copiar objetos (Formularios, Reportes etc) desde esta MDB
'a otra MDB protegida por contraseña

'Las llamadas a estas funciones de copiar objetos serían de esta forma, desde
'cualquier boton de comando de un formulario:

 'Primero, si la base destino tiene contraseña, quitarla:
  Desproteje "C:\Datos\MiBase.Mdb"

 '************************************************************************
 '* Los formularios a Copiar,  pueden ser nuevos, o bien                 *
 '* substituir a otros ya existentes. En el segundo caso, Acces          *
 '* me pide conformidad para sobreescribir. Siempre hay que decir que Sí *
 '* pues se trata de Actualizaciones.Los formularios origen, acompañan a *
 '* a esta base de actualización:Tanto los nuevos como los ya existentes.*
 '************************************************************************
 ' Por cada formulario a incorporar, haremos una llamada de este tipo
 Formulario = "Albaran2"
 CopiarFormularioAccess Destino, Formulario
 'otra llamada


'Estas son las funciones del modulo Bas que controla todo esto

Option Compare Database
Option Explicit
Sub CopiarFormularioAccess(RutaDestinoFormularios As String, NombreForm As String)
  DoCmd.CopyObject RutaDestinoFormularios, NombreForm, acForm, NombreForm
  Exit Sub
End Sub
Sub CopiarReportesAccess(RutaDestinoReportes As String, NombreReporte As String)
 DoCmd.CopyObject RutaDestinoReportes, NombreReporte, acReport, NombreReporte
 Exit Sub
End Sub
Sub CopiarModulos(RutaDestinoModulos As String, NombreModulo As String)
 DoCmd.CopyObject RutaDestinoModulos, NombreModulo, acModule, NombreModulo
 Exit Sub
End Sub


Sub Desproteje(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=1234")

 dbs.NewPassword "1234", ""
 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 FORMULARIOS"
 Resume Exit_Comando2_Click
End Sub


Sub Proteje(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 "", "1234"
 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 FORMULARIOS"
 Resume Exit_Comando2_Click
End Sub