Restaurar la base de datos ??

lebiatan123 · #1 (**permalink**) 25/10/2008, 11:14

HOLA FOTO. NECESITO SU AYUDA. NO SE COMO HACER PARA RESTAURAR LA BASE DE DATOS DEL SISTEMA. ESTE CODIGO LO UTILIZO PARA RESPALDAR :
Y CUANDO RESPALDO ME SALE ESTE MENSAJE :
ADODC1
NO ES UNA CONTRASEÑA VALIDA...

BUENO AQUI ESTAN LOS CODIGOS PARA RESPALDAR.:
Dim bCompactando As Boolean

Private Sub cmdRespaldar_Click()
Dim oMDB As DAO.Database
Dim nYesNo As VbMsgBoxResult

Dim sBackup As String, sOld_BDResi As String

Me.cmdRespaldar.Enabled = False
Me.CmdSalir.Enabled = False

On Error Resume Next

' Si la base de datos esta abierta, la cerramos ...
If Not BDResi Is Nothing Then
BDResi.Close
Set BDResi = Nothing
End If

On Error GoTo Error_CreateSubFolder

Me.txtAdvertencia = Me.txtAdvertencia & vbCrLf & vbCrLf & _
"Generando el subfolder para respaldo de la base de datos ..."
Me.txtAdvertencia.SelLength = Len(Me.txtAdvertencia)
Me.txtAdvertencia.SelStart = Len(Me.txtAdvertencia)
Me.txtAdvertencia.Refresh
DoEvents

' Si no existe el folder para respaldos, lo generamos ...

If Dir(App.Path & "\Respaldos\*.*", vbDirectory) = "" Then
MkDir App.Path & "\Respaldos"
End If

' Generamos nombre para respaldo (nombre mdb + fecha +hora.mdb) ...

sBackup = CStr(CSng(Now))
sBackup = Trim(Replace(sBackup, ".", "_"))

sBackup = App.Path & "\Respaldos\Residentes_" & sBackup & ".mdb"

On Error GoTo Error_Kill_Old_Backup

Me.txtAdvertencia = Me.txtAdvertencia & vbCrLf & vbCrLf & _
"Eliminando respaldo previo de la base de datos ..."
Me.txtAdvertencia.SelLength = Len(Me.txtAdvertencia)
Me.txtAdvertencia.SelStart = Len(Me.txtAdvertencia)
Me.txtAdvertencia.Refresh
DoEvents

' Si existe el archivo en folder de respaldos, eliminarlo ...

If Dir(sBackup) <> "" Then
Kill sBackup
End If

On Error GoTo Error_Exclusividad

Reintenta_Acceso_Exclusivo:

pRutaBDResi = "C:\sistema para trabajo especial de grado\base de datos\honorarios.mdb" ' ruta y nombre de la base de datos a respaldar ...
Set oMDB = DBEngine.OpenDatabase(pRutaBDResi, True, False, ";PWD=elPassword")

On Error GoTo 0

oMDB.Close
Set oMDB = Nothing

bCompactando = True

Me.txtAdvertencia = Me.txtAdvertencia & vbCrLf & vbCrLf & _
"Generando el respaldo de la base de datos ..."

Me.txtAdvertencia.SelLength = Len(Me.txtAdvertencia)
Me.txtAdvertencia.SelStart = Len(Me.txtAdvertencia)
Me.txtAdvertencia.Refresh
DoEvents

Me.MousePointer = vbHourglass
Screen.MousePointer = vbHourglass

DBEngine.CompactDatabase pRutaBDResi, sBackup, , , ";PWD=elPassword"

Me.txtAdvertencia = Me.txtAdvertencia & vbCrLf & vbCrLf & _
"Compactando la base de datos (Liberando Espacio) ..." & vbCrLf & vbCrLf

Me.txtAdvertencia.SelLength = Len(Me.txtAdvertencia)
Me.txtAdvertencia.SelStart = Len(Me.txtAdvertencia)
Me.txtAdvertencia.Refresh
DoEvents

' Antes de regresar la MDB compactada, renombro la mdb actual (solo por si acaso ...)

sOld_BDResi = pRutaBDResi & "_Old.mdb"

If Dir(sOld_BDResi) <> "" Then Kill sOld_BDResi

Name pRutaBDResi As sOld_BDResi

' Regreso la MDB compactada ...

DBEngine.CompactDatabase sBackup, pRutaBDResi, , , ";PWD=elPassword"

Me.txtAdvertencia = Me.txtAdvertencia & vbCrLf & vbCrLf & _
"Finalizó la generación del respaldo de la base de datos !" & vbCrLf & vbCrLf & _
"Si lo deseas, ya puedes salir de la aplicación y apagar el equipo ..." & vbCrLf

Me.txtAdvertencia.SelLength = Len(Me.txtAdvertencia)
Me.txtAdvertencia.SelStart = Len(Me.txtAdvertencia)
Me.txtAdvertencia.Refresh
DoEvents

bCompactando = False

Me.MousePointer = vbArrow
Screen.MousePointer = vbArrow

Me.txtAdvertencia.Enabled = True
Me.txtAdvertencia.Locked = True

Me.cmdRespaldar.Enabled = False
Me.CmdSalir.Enabled = True
Me.CmdSalir.Caption = "&Salir"

Exit Sub

Error_CreateSubFolder:
MsgBox "Error " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & vbCrLf & _
"Al intentar generar el subfolder " & App.Path & "\Respaldos" & vbCrLf, _
vbCritical + vbOKOnly

Me.txtAdvertencia = Me.txtAdvertencia & vbCrLf & vbCrLf & _
"El proceso de respaldo de la base de datos ha sido cancelado ..." & vbCrLf & vbCrLf

Me.txtAdvertencia.SelLength = Len(Me.txtAdvertencia)
Me.txtAdvertencia.SelStart = Len(Me.txtAdvertencia)

Me.CmdSalir.Enabled = True
bCompactando = False
Exit Sub

Error_Kill_Old_Backup:
MsgBox "Error " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & vbCrLf & _
"Al intentar eliminar respaldo antiguo " & sBackup & vbCrLf, _
vbCritical + vbOKOnly

Me.txtAdvertencia = Me.txtAdvertencia & vbCrLf & vbCrLf & _
"El proceso de respaldo de la base de datos ha sido cancelado ..." & vbCrLf & vbCrLf

Me.txtAdvertencia.SelLength = Len(Me.txtAdvertencia)
Me.txtAdvertencia.SelStart = Len(Me.txtAdvertencia)

Me.CmdSalir.Enabled = True
bCompactando = False
Exit Sub

Error_Exclusividad:
nYesNo = MsgBox("Error " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & vbCrLf & _
"Al intentar accesar en forma EXCLUSIVA la base de datos del sistema " & vbCrLf & _
vbCrLf & "Verifica que nadie esté laborando en el sistema !" & vbCrLf & _
vbCrLf & "Deseas reintentar el acceso ?", vbCritical + vbYesNo)

If nYesNo = vbYes Then
Resume Reintenta_Acceso_Exclusivo
End If

Me.txtAdvertencia = Me.txtAdvertencia & vbCrLf & vbCrLf & _
"El proceso de respaldo de la base de datos ha sido cancelado ..." & vbCrLf & vbCrLf

Me.txtAdvertencia.SelLength = Len(Me.txtAdvertencia)
Me.txtAdvertencia.SelStart = Len(Me.txtAdvertencia)

Me.CmdSalir.Enabled = True
bCompactando = False

Exit Sub

End Sub

GRACIAS. ESPERO ME PUEDAN A YUDAR PARA SOLUCIONAR EL MENSAJE ESE QUE ME SALE Y A RESTAURAR.

Avellaneda · #2 (**permalink**) 26/10/2008, 02:29

Cita:

Iniciado por lebiatan123

HOLA FOTO. NECESITO SU AYUDA. NO SE COMO HACER PARA RESTAURAR LA BASE DE DATOS DEL SISTEMA. ESTE CODIGO LO UTILIZO PARA RESPALDAR :
Y CUANDO RESPALDO ME SALE ESTE MENSAJE :
ADODC1
NO ES UNA CONTRASEÑA VALIDA...

...

GRACIAS. ESPERO ME PUEDAN A YUDAR PARA SOLUCIONAR EL MENSAJE ESE QUE ME SALE Y A RESTAURAR.

Bueno, me parece demasiado código para restaurar una base de datos. Con esta función puedes hacer copias y restauraciones de la BD, tenga o no password.

Código:

Public Function CopiaBDPwd(sOrigen As String, sDestino As String, Optional sPwd As String) As Boolean
 ' en Proyecto->Referencias: Microsof Jet and Replication objects 2.6 Library
    Dim je As JRO.JetEngine
    On Error GoTo hErr
    
    Set je = New JRO.JetEngine
    If Len(Dir$(sDestino)) Then Kill sDestino
    If IsMissing(sPwd) Then sPwd = ""
    je.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sOrigen & _
            ";Jet OLEDB:Database Password=" & sPwd, "Data Source=" & sDestino & _
            ";Jet OLEDB:Database Password=" & sPwd
    CopiaBDPwd = True
    Exit Function
hErr:
    MsgBox Err.Number & " - " & Err.Description
    CopiaBDPwd = False

End Function

Para hacer la copia:

Código:

Private Sub HacerCopia_Click()
Dim b As Boolean
b = CopiaBDPwd(App.Path & "\bd1.mdb", App.Path & "\BackUp\Copia de bd1.mdb", "miContraseña")
If b Then
    MsgBox "Copia realizada con éxito"
    ' ... instrucciones
Else
    ' otras instrucciones
End If
End Sub

Para restaurar llamamos a la misma función, pero invirtiendo el orden de las BDs.

Código:

Private Sub RestaurarCopia_Click()
Dim b As Boolean
b = CopiaBDPwd(App.Path & "\BackUp\Copia de bd1.mdb", App.Path & "\bd1.mdb", "miContraseña")
If b Then
    MsgBox "Se restauró con éxito"
    ' ... instrucciones
Else
    ' otras instrucciones
End If
End Sub

Mira a ver si lo puedes adecuar a tus necesidades.

lebiatan123 · #3 (**permalink**) 26/10/2008, 15:44

Gracias el codigo me sirvio a la perfeccion, y me ahorro vastantes lineas