Access - compactar con zip o winrar

Hola, es posible compactar una carpeta con contraseña usando zip o winrar desde access

Puedes especificar mas? Supongo que cuando dices "compactar", es comprimir, y cuando dices "una carpeta con contraseña" es crear un archivo comprimido con contraseña?

Saludos, en realidad si, fui muy escueto en ese sentido, tengo un programa en Access y necesito que la información que exporta a esa carpeta se proteja de esa forma, gracias

Hola,

Este código funciona con winrar, Las rutas de Carpetaorigen y Rarfilename, indica las que necesites:

me da este error

será porque uso un winrar que instala una aplicación que se llama TotalComander, y no como tal puro el winrar?

instalé winrar y me da este error

Es porque las rutas de las carpetas no las encuentra.

Application.currentproject.path es el lugar donde estas ejecutando la base de datos.

Tienes que poner la ruta absoluta, por ejemplo:

Carpetaorigen = "C:\Archivooriginal\"
Rarfilename = "C:\\Archivocomprimido\comprimido.rar"

amigo, gracias, todo funcionó bien, de todas formas voy a tratar de probar la variante de que cada vez que haga una exportación la compacte para que así no sea al final de todas, es para salvaguardar la información y no sea modificada pues ya está comprimida, le comento luego, una vez más, gracias

Amigo Joan, como le comenté he puesto a cada exportación que vaya comprimiendo la carpeta, hasta ahora me funcionó bien y lo hice así:

Private Sub cmdExpPago_Click()
Dim Tbl_Temp As DAO.Recordset
Set Tbl_Temp = CurrentDb.OpenRecordset("Select CodEmisora FROM 01TNomencladorEmisora", , dbReadOnly)
Tbl_Temp.MoveFirst
Do Until Tbl_Temp.EOF
DoCmd.OutputTo acOutputQuery, "InformeACDAMOC", "HTML(*.html)", "D:\SG RADIO\INFORMACIONES\EXPORTACIONES\InformePagoACDAM1 " & DLookup("CodEmisora", "01TNomencladorEmisora") & ".html"
DoCmd.OutputTo acOutputQuery, "InformeACDAMTI", "HTML(*.html)", "D:\SG RADIO\INFORMACIONES\EXPORTACIONES\InformePagoACDAM2 " & DLookup("CodEmisora", "01TNomencladorEmisora") & ".html"
Tbl_Temp.MoveNext
Loop
Tbl_Temp.Close
Set Tbl_Temp = Nothing

Dim CarpetaOrigen As String
Dim RarFileName As String
Dim Password As String

' Ruta de la carpeta que deseas comprimir
CarpetaOrigen = Application.CurrentProject.Path & "\INFORMACIONES\EXPORTACIONES"

' Nombre y ubicación del archivo comprimido

RarFileName = "D:\" & DLookup("Emisora", "01TNomencladorEmisora") & " EXPORTACIONES.rar"

' Contraseña para el archivo RAR
Password = "cd202319*"

' Comando para comprimir con WinRAR
Dim Command As String
Command = """C:\Program Files\WinRAR\WinRAR.exe"" a -hp" & Password & " """ & RarFileName & """ """ & CarpetaOrigen & """"

DoCmd.Hourglass True

Shell Command, vbNormalFocus

WaitForRarCompletion 5 ' Espera 5 segundos

DoCmd.Hourglass False

MsgBox "La carpeta se ha comprimido correctamente.", vbInformation

End Sub


Ahora, es este paso no lo hace, aquí se construye un libro con varias hojas a partir de consulta:

Private Sub cmdExpDAOC_Click()
Dim rstNombrePrograma As DAO.Recordset, _
rstTituloTema As DAO.Recordset, _
qdf As DAO.QueryDef, _
strSQL As String, _
strHoja As String, _
strArchivo As String, _
strTitulo As String, _
Campo As DAO.Field, _
lngColumna As Long, _
i As Long, _
xls As Object

Const xlWBATWorksheet = -4167
Const xlAutomatic = -4105
Const xlSolid = 1
Const xlThemeColorDark1 = 1
Const xlToRight = -4161
Const xlNormal = -4143

On Error GoTo cmdExpDAOC_Click_TratamientoErrores

strSQL = "SELECT NombrePrograma"
strSQL = strSQL & " FROM ProgramasEmitidosDerAut"
strSQL = strSQL & " GROUP BY NombrePrograma"

Set xls = CreateObject("Excel.Application")
xls.Visible = True

xls.Workbooks.Add xlWBATWorksheet
strHoja = xls.ActiveSheet.Name

Set rstNombrePrograma = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

If Not (rstNombrePrograma.EOF And rstNombrePrograma.BOF) Then
Do
strSQL = "SELECT TituloTema, NombreAutor, NombreInterprete, Sonatas, Fecha, Calculo, Local, Plantilla "
strSQL = strSQL & "FROM ProgramasEmitidosDerAut"
strSQL = strSQL & " WHERE NombrePrograma = Parametro1"
Set qdf = CurrentDb.CreateQueryDef("", strSQL)

qdf.Parameters("Parametro1") = rstNombrePrograma!NombrePrograma
Set rstTituloTema = qdf.OpenRecordset
xls.ActiveWorkbook.Sheets.Add Before:=xls.Worksheets(xls.Worksheets.Count)
xls.ActiveSheet.Name = rstNombrePrograma!NombrePrograma

With xls
lngColumna = 1
For Each Campo In rstTituloTema.Fields
strTitulo = ""
For i = 1 To Len(Campo.Name)
strTitulo = strTitulo & Mid(Campo.Name, i, 1)
If i < Len(Campo.Name) Then
If EsMayuscula(Mid(Campo.Name, i + 1, 1)) Then strTitulo = strTitulo & " "
End If
Next i
.ActiveSheet.Cells(1, lngColumna) = strTitulo
lngColumna = lngColumna + 1
Next Campo
.Range("A1").Select
.Range(.Selection, .Selection.End(xlToRight)).Select
.Selection.Font.Bold = True
With .Selection.Interior
.Pattern = xlSolid
.ColorIndex = 15
End With
End With

If Not (rstTituloTema.EOF And rstTituloTema.BOF) Then
xls.ActiveSheet.Cells(2, 1).CopyFromRecordset rstTituloTema
End If
xls.Columns("A:G").EntireColumn.AutoFit
rstNombrePrograma.MoveNext
Loop Until rstNombrePrograma.EOF
End If

xls.Application.DisplayAlerts = False
xls.ActiveWorkbook.Worksheets(strHoja).Delete

strArchivo = "D:\SG RADIO\INFORMACIONES\ACDAM\" & DLookup("Emisora", "01TNomencladorEmisora") & " Derecho Autor Obras Completas.xls"
If Not Nz(strArchivo, "") = "" Then
xls.ActiveWorkbook.SaveAs FileName:=strArchivo, FileFormat:=xlNormal
Else
xls.ActiveWorkbook.Saved = True
End If
xls.Application.DisplayAlerts = True

cmdExpDAOC_Click_Salir:
On Error Resume Next
xls.Quit
Set xls = Nothing
Set qdf = Nothing
CierraRecordsetDAO rstNombrePrograma
CierraRecordsetDAO rstTituloTema
On Error GoTo 0
Exit Sub

cmdExpDAOC_Click_TratamientoErrores:
MsgBox "Error " & Err & " en proc.: cmdExpDAOC_Click de Documento VBA: Form_frmFrmIniCaptacion (" & Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"
Resume cmdExpDAOC_Click_Salir
Resume Next

Dim CarpetaOrigen As String
Dim RarFileName As String
Dim Password As String

' Ruta de la carpeta que deseas comprimir
CarpetaOrigen = Application.CurrentProject.Path & "\INFORMACIONES\ACDAM"

' Nombre y ubicación del archivo comprimido

RarFileName = "D:\" & DLookup("Emisora", "01TNomencladorEmisora") & " ACDAM.rar"

' Contraseña para el archivo RAR
Password = "cd202319*"

' Comando para comprimir con WinRAR
Dim Command As String
Command = """C:\Program Files\WinRAR\WinRAR.exe"" a -hp" & Password & " """ & RarFileName & """ """ & CarpetaOrigen & """"

DoCmd.Hourglass True

Shell Command, vbNormalFocus

WaitForRarCompletion 5 ' Espera 5 segundos

DoCmd.Hourglass False

MsgBox "La carpeta se ha comprimido correctamente.", vbInformation

End Sub

Me pudiera ayudar? el tiempo que aparece aquí debajo es lo que la instrucción espera para ejecutarse o es otra cosa:

WaitForRarCompletion 5 ' Espera 5 segundos

Estaba pensando que a lo mejor era eso, no se

Es un tiempo para que espere a realizar la compresión en Rar. Puedes poner el tiempo que quieras en segundos.

También puedes omitir esas líneas de código y ver si te hace las exportaciones y compresiones correctamente.

hace bien las cuatro primeras exportaciones a la carpeta que le corresponde y en la medida que se comprimen le va agregando los nuevos datos, de ahí en adelante, que son exportaciones a otras carpetas no lo hace no quitándole o aumentándole más tiempo

Separa el código para probar, primero haz las exportaciones, cuando hayan finalizado haz las compresiones de las carpetas.

Si te funciona tanto una parte como la otra, pon la linea WaitForRarCompletion 5 al principio del código de compresión en Rar tambien.

no amigo, no lo hace, no será por el tipo de función? porque la exportación de consultas en formato .HTML lo hace bien, pero esta es una exportación a excel donde se construye la tabla desde la función, imagino que no debía pero se me ocurre decirte, otra cosa, poniendo un botón independiente lo hace de maravillas, lo que desearía que se comprimiera inmediatamente al exportar para evitar posible manipulación de los datos que son para el pago de derecho de autor musical

El proceso tiene sus limitaciones al exportar, tarda más y depende del PC que se use también. Intercala la compresión, exportas una hoja, la comprimes, exportas otra, y así sucesivamente.

Puedes probar intercalando también después de cada exportación.

No sé que más indicarte.

Suerte.

Está bien amigo, gracias por todo