amma.NETtami

.NET walkabout
posts - 11, comments - 18, trackbacks - 0

How to zip a file using Visual Basic 6 and the Windows Shell

When it was a matter of zipping a file, I always choosed the easy way: find a thirdy part activex or dll which could do the job for me.

This time, I wanted to find my way to zip a file using Visual Basic 6 (or Visual Basic for Application - aka VBA) and the windows shell. The consderation came from the fact that, since Windows XP,  the support of zipping-unizzping files is a native feature of the OS.

After a long search and multiple fixes, I finally came up with a stable solution which I'm going to quickly explain and post right here. The source code is a mix of pieces of code collected here and there. the only att

Attached to the post it's a zip file containing a working example. It zips the files contained in the testFolder directory.

Click here to download the zip.

I'm going to post just the clsZip class I used to support my zipping project.

clsZip.cls
Option Explicit

Private objShell As Object
Private mvarZipFileName As String

Const FOF_NOCONFIRMATION = &H14

Private Sub Class_Initialize()
Set objShell = CreateObject("Shell.Application")
End Sub

Private Sub Class_Terminate()
Set objShell = Nothing
End Sub

Public Property Let ZipFileName(ByVal vData As String)
    mvarZipFileName = vData
End Property

Public Property Get ZipFileName() As String
    ZipFileName = mvarZipFileName
End Property


Private Sub CreateEmptyZip(sPath)

    Dim strZIPHeader As String
    
    Dim fso As Object
    
    strZIPHeader = Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, vbNullChar)
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    With fso
        .CreateTextFile(sPath).Write strZIPHeader
    End With
    
    Set fso = Nothing
    
End Sub

Public Function AddFilesToZip(sFileNames() As String) As Boolean

Dim i As Long
Dim iCount As Long

    On Error GoTo AddFilesToZip_Error
    
    CreateEmptyZip mvarZipFileName
    
    On Error Resume Next
    For i = LBound(sFileNames) To UBound(sFileNames)
        objShell.Namespace("" & mvarZipFileName).CopyHere "" & sFileNames(i), FOF_NOCONFIRMATION
        
        iCount = objShell.Namespace("" & mvarZipFileName).items.Count
    
        Do Until iCount = i + 1
            Sleep 100
            iCount = objShell.Namespace("" & mvarZipFileName).items.Count
        Loop
        
    Next
        
    On Error GoTo 0
    Exit Function

AddFilesToZip_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure AddFilesToZip of Modulo di classe clsZip"

End Function
Public Function UnzipToFolder(sFolderName As String) As Boolean

    objShell.Namespace("" & sFolderName).CopyHere objShell.Namespace("" & mvarZipFileName).items

End Function

Technorati tags: , , ,

Print | posted on Friday, March 27, 2009 11:40 AM | Filed Under [ Visual Basic VBA ]

Powered by:
Powered By Subtext Powered By ASP.NET