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:
zip,
Visual basic 6,
vba,
windows shell