Macro de Excel que comprime archivos en extensión zip




En un sin número de post presentados se han agregado ejemplos de macros variados, pero nunca relacionado con comprimir archivos con Excel, es por ello que en esta oportunidad presento una macro que permite comprimir archivos con extensión zip; relacionado con el post se encuentra un presentación denominada crea carpeta y guarda con nombre variable en PDF o enviar mail con Excel mediante Outlook adjuntando archivos en PDF.

Antes de continuar, recomiendo que leas un excelente libro sobre Excel el que te ayudará operar las planillas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.






La utilidad del ejemplo radica en que algunas veces se trabaja con muchos archivos que se deben pasar a histórico y con esta macro se podría comprimir los ficheros a tal fin o bien si se desea mandar un mail con archivos adjuntos, siempre es preciso comprimir a los fines de disminuir el tamaño de los ficheros enviados.

Aconsejo descargar el ejemplo desde el link del final y de esta manera comprender como funciona la macro que permite comprimir archivos en extensión zip; el archivo contiene un botón que al presionarlo se ejecuta una macro que en un primer momento muestra un explorador de archivos de Windows multiselect; donde se podrán seleccionar uno o mas archivos a comprimir.

Seleccionados los archivos, las restantes sentencias, permiten crear el archivo Zip y agregar uno por uno los archivos seleccionados mediante el explorador de archivos; una vez que se terminó de agregar todos los ficheros, aparece un msgbox preguntando si desea abrir el archivo Zip guardado, en caso que la respuesta sea afirmativa, abre el archivo zip, donde se podrán observar los archivos que se guardaron con la macro.

Considera aportar a los fines de seguir manteniendo el sitio, suscribe al blog para recibir en tu correo todas las actualizaciones, dispones también de un canal de You Tube donde encontrarás explicaciones de macros con mayor detalle.

Código que se inserta en un módulo



Sub ComprimirArchivos()


Dim SApp As Object, FZip As Variant, myfile As Variant, myi As Long, cant As Long
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set SApp = CreateObject("Shell.Application")
myfile = Application.GetOpenFilename("Archivos Excel (*.xl*), *.xl*", , , , True)
cant = UBound(myfile)
If VarType(myfile) = vbBoolean Then
Exit Sub
End If
FZip = ActiveWorkbook.Path & "\188 Macro para comprimir archivos.zip"

Open FZip For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

For myi = LBound(myfile) To UBound(myfile)
SApp.Namespace(FZip).CopyHere myfile(myi)
Next myi

resp = MsgBox(cant & " archivos se han comprimido en:" & vbNewLine & FZip & vbNewLine & vbNewLine & _
       " Desea ver los archivos comprimidos...", vbQuestion + vbYesNo)
If resp = 6 Then Shell "Explorer.exe /e," & FZip, vbNormalFocus

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends