Menú Principal

Clics de vista de contenido : 60275

Comprimir/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 estandard
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