12 marzo, 2019

Comprimir o Descomprimir con 7z

Pues esta es una manera de comprimir y descomprimir una carpeta desde Access 2003. Debo dar las gracias a Genoma 111 del foro mvp-access por su aportación. Para comprimir utilizaremos el compresor gratuito 7z, y cuyo exe (7za.exe) deberemos tener dentro de una carpeta. Primero ponemos esto en un módulo estándar.
Option Compare Database
Option Explicit

Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
    Dim hProg As Long
    Dim hProcess As Long, ExitCode As Long

    If IsMissing(WindowState) Then WindowState = 1
    hProg = shell(PathName, WindowState)

    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, True, hProg)
    Do
        GetExitCodeProcess hProcess, ExitCode
            DoEvents
            Loop While ExitCode = STILL_ACTIVE
        End Sub


Luego en unos botones de formulario ponemos esto para
comprimir y descomprimir


        Private Sub cmdDesComprime_Click
            'Con este código descomprime el archivo CopiaDatos.zip
            Dim str7z As String, strFolder As String
            Dim strZip As String, comando As String

            'Carpeta donde se encuentra el exe.
            str7z = "C:\Numisoftware\Programa\Compresor\"
            'Ruta de la carpeta a copiar 
            strFolder = "C:\Numisoftware\datos\"
            ' ruta donde se creara la copia
            strZip = "C:\Numisoftware\CopiaDatos.zip"

            comando = str7z & "7za.exe x -aoa -r" _
            & " " & Chr(34) & strZip & Chr(34) _
            & " -o" & Chr(34) & strFolder & Chr(34) & " " & "*.*"
            ShellAndWait comando, vbHide
        End Sub

        Private Sub cmdComprime_Click
            'Con esto comprime dentro de la carpeta Numisoftware
            Dim str7z As String, strZip As String
            Dim strFile As String, comando As String

            'Carpeta donde se encuentra el exe.
            str7z = "C:\Numisoftware\Programa\Compresor\"
            'Ruta donde se encuentra la copia
            strZip = Me.Path & "\CopiaDatos.zip"
            ' El destino de la descompresión
            strFile = "C:\Numisoftware\DatosNumi"

            comando = str7z & "7za.exe a" _
            & " " & Chr(34) & strZip & Chr(34) _
            & " " & strFile
            ShellAndWait comando, vbHide
        End Sub