Crear Respaldo/BackUp Comprimido en Formato RAR desde Access
Option Compare Database
Option Explicit
'***************************************************************
'& &*
'& &*
'& &*
'& &*
'& Jefferson Jimenez (JJJT) &*
'& Cabimas - Venezuela &*
'& Octubre - 2010 &*
'& &*
'& &*
'& &*
'& &*
'& &*
'***************************************************************
Function CopiarComprimir(Optional Origen As String)
'Variables de uso
Dim ObjCopiar As Object
Dim Sel As Boolean
Dim Destino As String
Dim RutaCompresor As String
Dim RutaSelFile As String
Dim RutaDestino As String
Dim FileProg As String
Dim Clave As String
Set ObjCopiar = CreateObject("Scripting.FileSystemObject")
If Origen = "" Then
Origen = RutaCarpeta & "\" & BDVinculada
Destino = "C:\" & BDVinculada
RutaDestino = """" & CurrentProject.Path & "\" & User(BDVinculada, ".") & ".rar"""
Sel = True
ObjCopiar.CopyFile Origen, Destino
Else
Origen = Origen
Destino = "C:\" & Right(Origen, Len(Origen) - InStrRev(Origen, "\"))
RutaDestino = """" & CurrentProject.Path & "\" & _
User(Right(Origen, Len(Origen) - InStrRev(Origen, "\")), ".") & ".rar"""
ObjCopiar.CopyFile Origen, Destino
Kill Origen
End If
'Busco la Carpeta Archivo de Programas, que es donde esta el WINRAR
FileProg = Environ$("programfiles")
RutaCompresor = """" & FileProg & "\WinRAR\Rar.exe"""
RutaSelFile = """" & Destino & """"
If BtnCheck1 Or BtnCheck2 Then
Clave = InputBox("Ingrese una clave, para codificar el BackUp", "Dame Password")
'Ejecuto el WINRAR pasandole una linea de comando
Shell _
"" & RutaCompresor & " m -agDD-MMM-YY -p" _
& Clave & " " _
& RutaDestino & " " & _
RutaSelFile & "", vbHide
Else
Shell _
"" & RutaCompresor & _
" m -agDD-MMM-YY " & _
RutaDestino & " " & _
RutaSelFile & "", vbHide
End If
Select Case Sel
Case True
MsgBox "Listo, el proceso de compresion ha concluido" & vbCrLf & vbCrLf & _
"Se ha guardado el Respaldo BackUp en esta Carpeta " & vbCrLf & _
"Con el nombre : " & User(BDVinculada, ".") & Format(Date, "dd-mmm-yy") & ".rar", vbInformation, NombreBD
Case Else
MsgBox "Listo, el proceso de compresion ha concluido" & vbCrLf & vbCrLf & _
"Se ha guardado el Respaldo BackUp en esta Carpeta " & vbCrLf & _
"Con el nombre : " & User(Right(Origen, Len(Origen) - InStrRev(Origen, "\")), ".") & Format(Date, "dd-mmm-yy") & ".rar", vbInformation, NombreBD
End Select
End Function
Function User(StrCtl As String, Caracter As String) As String
'Con esta funcion reviso una cadena, para eliminar algun caracter que le indique
Dim Usere As String
Usere = Right(StrCtl, Len(StrCtl) - InStrRev(StrCtl, Caracter) + 1)
If Left(Usere, 1) = Caracter Then
User = Left(StrCtl, InStrRev(StrCtl, Caracter) - 1)
Else
User = StrCtl
End If
End Function
Function DesComprimir()
'Variables de Uso
Dim RutaCompresor As String
Dim RutaSelFile As String
Dim RutaExtract As String
Dim FileProg As String
FileProg = Environ$("programfiles")
RutaCompresor = """" & FileProg & "\WinRAR\WinRAR.exe"""
Call JJJT_CuadroDialog("Archivos RAR" + Chr$(0) + "*.rar", CurrentProject.Path & "\")
RutaSelFile = """" & Var & """"
RutaExtract = CurrentProject.Path & "\"
'Ejecuto el WINRAR pasandole una linea de comando
Shell _
"" & RutaCompresor & " x -o+ " & _
RutaSelFile & " " & _
RutaExtract & "", vbHide
'Fin de la instruccion
End Function