domingo, 10 de junio de 2012

COMPRIMIR ARCHIVOS

Los archivos en formato ZIP probablemente sean los tipos de archivos mas utilizados, este ejemplo muestra como crear un archivo ZIP de un grupo de archivos seleccionados por el usuario con el método (Application.GetOpenFilename). Después crea un archivo llamado PruebaComprimir.zip en el directorio donde este guardado el Excel que contenga el siguiente procedimiento.

Sub ComprimirArchivos()
    Dim ShellApp As Object
    Dim FileNameZip As Variant
    Dim FileNames As Variant
    Dim i As Long, FileCount As Long

'   Obtener los nombres de los archivo
    FileNames = Application.GetOpenFilename _
        (FileFilter:="Todos los archivos. (*.*),*.*", _
         FilterIndex:=1, _
         Title:=" Seleccione los archivos para comprimir. ", _
         MultiSelect:=True)

'   Salir si se cancela el cuadro de diálogo
    If Not IsArray(FileNames) Then Exit Sub
  
    FileCount = UBound(FileNames)
    FileNameZip = Application.DefaultFilePath & "\PruebaComprimir.zip"
   

  
'   Crear archivo Zip vacío...
    Open FileNameZip For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1

    Set ShellApp = CreateObject("Shell.Application")

'   Copia los archivos a la carpeta comprimida
    For i = LBound(FileNames) To UBound(FileNames)
        ShellApp.Namespace(FileNameZip).CopyHere FileNames(i)
    Next i

    On Error Resume Next
    Do Until ShellApp.Namespace(FileNameZip).items.Count = FileCount
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
   
    If MsgBox(FileCount & " Los archivos se han comprimido en:" & _
       vbNewLine & FileNameZip & vbNewLine & vbNewLine & _
       " Quieres ver el archivo zip?", vbQuestion + vbYesNo) = vbYes Then _
       Shell "Explorer.exe /e," & FileNameZip, vbNormalFocus
End Sub




No hay comentarios:

Publicar un comentario

Nota: solo los miembros de este blog pueden publicar comentarios.