Como crear un Back up y como restaurar ese back up

[gringocre]

Hola a todos... bueno esta es mi duda... no se como hacer un backup (en visual 6.0) de mi DB q esta echa en access... y tampoco sé como hacer para recuperar esa base de datos...
si alguien me da una mano le agradecería mucho!

Gracias

[shaggikpo]

Mira para crear un bakup solo deberias indicarle a tu programa que cree una copia de la base de dtaos cada vez que esta se modifique y que lo guarde con el mismo nombre en una carpeta apart llamada backup con extencion Bak y y para restaurar solo tenes decirle que remplace el archivo actual po el archivo bak mas reciente

[marceperez322]

El formulario principal consta de 2 botones (CmdCopiaseguridad y CmdRecuperar) y de un CommonDialog (DlgArchivos) y PictureBox (Mensaje), en mi caso.
Los dirección de la base respaldada se guardan en el archivo config.ini el cual se crea cuando se inicia la aplicación. Hay que crear un Modulo Bas, mas abajo esta el código
La base de datos debe de estar cerrada de lo contrario da error

//// Form
Dim DirAnterior As String
Dim NomArchivoSeg As String
Dim FActual As String
Const TITULO = "BACKUP" 'el titulo de la ventana y de los msgbox

Private Sub CmdCopiaseguridad_Click()
CompactarBD
If DirAnterior <> "" Then
DlgArchivos.InitDir = DirAnterior
Else
DlgArchivos.InitDir = DameDirectorioAplicacion
End If

DlgArchivos.FileName = FActual
On Error GoTo ManipularErrorGuardar
DlgArchivos.CancelError = True
DlgArchivos.Filter = "Ficheros de proyecto (*.bak)|*.bak|Todos los ficheros (*.*)|*.*"
DlgArchivos.FilterIndex = 1

DlgArchivos.ShowSave

Label14.Caption = "Copiando copia de seguridad"
DoEvents
SHCopyFile App.Path & "\bd.mdb", DlgArchivos.FileName

Dim Indice As Long

For Indice1 = Len(DlgArchivos.FileName) To 1 Step -1
If Mid$(DlgArchivos.FileName, Indice1, 1) = "\" Then Exit For
Next

NomArchivoSeg = Mid$(DlgArchivos.FileName, Indice1 + 1, Len(DlgArchivos.FileName))
DirAnterior = Mid$(DlgArchivos.FileName, 1, (Len(DlgArchivos.FileName) - Len(NomArchivoSeg)) - 1)

SalirGuardar:

Mensaje.Visible = False
MsgBox "Finished backup", vbInformation, TITULO

Screen.MousePointer = 0
Exit Sub

ManipularErrorGuardar:

Screen.MousePointer = 0
Mensaje.Visible = False
If Err.Number = cdlCancel Then Exit Sub
MsgBox Err.Description
Resume SalirGuardar

End Sub

Private Function CompactarBD()

Screen.MousePointer = 11

On Error Resume Next

Dim BaseDeDatos As String
Dim BaseDeDatosCo As String

BaseDeDatos = App.Path & "\bd.mdb" 'la direccion de la base de datos original
BaseDeDatosCo = Mid$(BaseDeDatos, 1, Len(BaseDeDatos) - 4) & "Co.mdb" 'la direccion que tendra la copia

If Dir(DameDirectorioAplicacion & "~bdatos.mdb") Then _
Kill DameDirectorioAplicacion & "~bdatos.mdb"

Mensaje.Visible = True
Label14.Caption = "Copia de seguridad en progreso"
DoEvents

FileCopy BaseDeDatos, DameDirectorioAplicacion & "~bdatos.mdb"
If Dir(BaseDeDatosCo) <> "" Then _
Kill BaseDeDatosCo

Label14.Caption = "Compactando base de datos"

DoEvents
DBEngine.CompactDatabase BaseDeDatos, _
BaseDeDatosCo, dbLangGeneral

'si nuestra bd tiene contraseña se haría con esta instrucción:
' DBEngine.CompactDatabase BaseDeDatos, _
' BaseDeDatosCo, dbLangSpanish & ";pwd =" & gClave, , ";pwd =" & gClave
'si tiene contraseña, hay que añadir ,pwd="contraseña"

If Dir(BaseDeDatosCo) <> "" Then
Kill BaseDeDatos
End If

Label14.Caption = "Restaurando base de datos"
DoEvents

FileCopy BaseDeDatosCo, BaseDeDatos

Kill BaseDeDatosCo
Kill DameDirectorioAplicacion & "~bdatos.mdb"


Screen.MousePointer = 0

Label14.Caption = "Base de datos compactada"
DoEvents

End Function

Private Sub CmdRecuperar_Click()

DlgArchivos.CancelError = True
On Error Resume Next
DlgArchivos.FileName = NomArchivoSeg
DlgArchivos.InitDir = DirAnterior
DlgArchivos.Filter = "Backup (*.bak)|*.bak|" & "all files (*.*)|*.*"
DlgArchivos.Action = 1
If Err.Number = 0 Then

On Error Resume Next

If MsgBox("La base de datos será reemplazada, ¿Estas seguro?", vbQuestion + vbYesNo, TITULO) <> vbYes Then Exit Sub
Screen.MousePointer = 11
On Error Resume Next
FileCopy DlgArchivos.FileName, App.Path & "\bd.mdb"
If Err.Number <> 0 Then
MsgBox "Error recuperando la base de datos", vbCritical, TITULO
Else
MsgBox "Recuperacion de la base de datos completa", vbInformation, TITULO
End If
On Error GoTo 0
Screen.MousePointer = 0

Else
MsgBox "Restauración de la base de datos cancelada por el usuario", vbInformation, TITULO
End If


End Sub

Private Sub Form_Load()
Dim nPermiso As Integer

Me.Caption = TITULO

Screen.MousePointer = 0

FActual = Format(Now, "dd_mm_yyyy")

'comprobar si existe el archivo ini

If Not ExisteArchivo(DameDirectorioAplicacion & "config.ini") Then
DirAnterior = DameDirectorioAplicacion
'si no existe dar direccion por defecto (en este caso, la carpera del programa)
Else
DirAnterior = LeerIni(DameDirectorioAplicacion & "config.ini", "CopiaBD", "DirCopia")
NomArchivoSeg = LeerIni(DameDirectorioAplicacion & "config.ini", "CopiaBD", "NombreCopia")

If Trim$(DirAnterior) <> "" Then
DirAnterior = Mid(DirAnterior, 1, Len(Trim$(DirAnterior)) - 1)
Else
DirAnterior = DameDirectorioAplicacion
End If

If Trim$(NomArchivoSeg) <> "" Then
NomArchivoSeg = Mid(NomArchivoSeg, 1, Len(Trim$(NomArchivoSeg)) - 1)
End If

End If
End Sub
Private Sub Form_Unload(Cancel As Integer)

If DirAnterior <> "" Then
EscribirIni "CopiaBD", "DirCopia", DirAnterior, DameDirectorioAplicacion & "config.ini"
End If

If NomArchivoSeg <> "" Then
EscribirIni "CopiaBD", "NombreCopia", NomArchivoSeg, DameDirectorioAplicacion & "config.ini"
End If

End Sub

Function DameDirectorioAplicacion() As String

DameDirectorioAplicacion = UCase$(App.Path)
If Right(DameDirectorioAplicacion, 1) <> "\" Then DameDirectorioAplicacion = DameDirectorioAplicacion & "\"

End Function

//// El Modulo bas

Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As _
String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As _
String) As Long

Public Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As _
Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Option Explicit
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long

Private Const FO_COPY = &H2
Private Const FOF_ALLOWUNDO = &H40

Public Function LeerIni(Archivo As String, Situacion As String, campo As String) As String
Dim i As Integer
Dim Est As String
Est = String$(150, " ")
i = GetPrivateProfileString(Situacion, campo, "", Est, Len(Est), Archivo)
If i > 0 Then LeerIni = Est
End Function

Public Function EscribirIni(Situacion As String, campo As String, Valor As String, Archivo As String)
Dim i As Integer
Dim Est As String

Est = Valor
i = WritePrivateProfileString(Situacion, campo, Est, Archivo)

End Function

Public Function ExisteArchivo(Nombre As String) As Boolean

Dim Cadena As String
Dim x As Long

On Error GoTo Fallo
If Nombre = "" Then
Exit Function
End If
Cadena = Nombre
x = GetAttr(Cadena)
ExisteArchivo = True
Exit Function
Fallo:
ExisteArchivo = False
End Function

Function DameDirectorioAplicacion() As String

DameDirectorioAplicacion = UCase$(App.Path)
If Right(DameDirectorioAplicacion, 1) <> "\" Then DameDirectorioAplicacion = DameDirectorioAplicacion & "\"

End Function

Public Sub SHCopyFile(ByVal from_file As String, ByVal to_file As String)
Dim sh_op As SHFILEOPSTRUCT

With sh_op
.hwnd = 0
.wFunc = FO_COPY
.pFrom = from_file & vbNullChar & vbNullChar
.pTo = to_file & vbNullChar & vbNullChar
.fFlags = FOF_ALLOWUNDO
End With

SHFileOperation sh_op
End Sub

////

Espero que sirva. Se que es un disparate de código pero es el de mejor resultado que tengo, ya que no solo respalda sino también compacta. Tal vez alguien sepa de uno mas simple y compacto.
Saludos Marcelo

[Avellaneda]

Iniciado por marceperez322

////

Espero que sirva. Se que es un disparate de código pero es el de mejor resultado que tengo, ya que no solo respalda sino también compacta. Tal vez alguien sepa de uno mas simple y compacto.
Saludos Marcelo

La verdad es que sí, creo que es demasiado código para solamente copiar y compactar una base de datos.

Basándonos en un ejemplo que puse hace unos días:

Código:

Public Function CopiaBDPwd(sOrigen As String, sDestino As String, Optional sPwd As String) As String
    ' en Proyecto->Referencias: Microsof Jet and Replication objects 2.6 Library
    Dim je As JRO.JetEngine
    
    Set je = New JRO.JetEngine
    If Len(Dir$(sDestino)) Then Kill sDestino
    If IsMissing(sPwd) Then sPwd = ""
    je.CompactDatabase "Data Source=" & sOrigen & ";" & _
            "Jet OLEDB:Database Password=" & sPwd, "Data Source=" & sDestino & ";"
    
    CopiaBDPwd = "Realizada copia con éxito en '" & sDestino & "'."
End Function

Para hacer la copia:

Código:

Private Sub HacerCopia_Click()
MsgBox CopiaBDPwd(App.Path & "\MiDB.mdb", App.Path & "\BackUp\Copia de MiDB.mdb", "MiPassword")
End Sub

Para restaurar la copia:

Código:

Private Sub RestaurarCopia_Click()
MsgBox CopiaBDPwd(App.Path & "\BackUp\Copia de MiDB.mdb", App.Path & "\MiDB.mdb", "MiPassword")
End Sub

Si la base de datos no tiene Password, no le pasas el último parámetro:
CopiaBDPwd(App.Path & "\MiDB.mdb", App.Path & "\BackUp\Copia de MiDB.mdb")

[gringocre]

ok gracias todos, ahora me voy a poner a probar, luego aviso si me funciona, espero que si...
gracias!



edito: probé el codigo de avellaneda y anda perfecto... gracias, y gracias tambien a marceperez322... les debo un asado a los dos! jeje ;)


Gringo