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


SelectionFile type iconFile nameDescriptionSizeRevisionTimeUser
ċ

Descargar
Descargue el Ejemplo  206 kb v. 3 5 oct. 2010 9:59 Jefferson Jimenez
Comments