Zip and Unzip from Microsoft Access VBA

Click image to learn more about the book

On occasions, we have a need to zip files as part of our workflow within Access VBA. One sore point with zipping is that there’s really no simple way to zip or unzip files without depending on a third-party utilities. When you think about it, it is quite odd considering that zipping is built-in to Windows Explorer. (Reading between the lines, it seems to do with licensing constraints).

Thankfully, Ron de Bruin has provided a solution which involves automating the Windows Explorer (aka Shell32). A Shell32.Folder object can be either a real folder or a zip folder so by manipulating a zip file as if it was a Shell32.folder, we can then use the “Copy Here” method of the Shell32.Folder to move the files in and out of a zip file.

As Ron has noted, there is a subtle bug when dealing with retrieving a Shell32.Folder via Shell32.Applications’ Namespace method. This code will not work as expected:
Dim s As String
Dim f As Object 'Shell32.Folder

s = “C:MyZip.zip”
Set f = CreateObject(“Shell.Application”).Namespace(s)
f.CopyHere “C:MyText.txt” ‘Error occurs here
According to MSDN documentation, if Namespace method fails, the return value is a nothing and therefore we can get seemingly unrelated error 91 “With or object variable not set”. This is why Ron de Bruin uses a variant in his sample. Converting the string into a variant will work also:
Dim s As String
Dim f As Object 'Shell32.Folder

s = “C:MyZip.zip”
Set f = CreateObject(“Shell.Application”).Namespace(CVar(s))
f.CopyHere “C:MyText.txt”
Alternatively, you can choose to early bind by referencing Shell32.dll (typically in WindowsSystem32 folder). In VBA references dialog, it is labeled “Microsoft Shell Controls and Automation”. Early-binding is not subject to the string variable bug. However, our preference is to late-bind as to avoid any problems with versioning that may occur when running code on different computer with different operating systems, service packs and so forth. Still, referencing can be useful for developing & validating your code prior to switching to late binding & distribution.

Another issue we have to handle is that as there is only either “Copy Here” or “Move Here” method available with a Shell32.Folder object, we have to consider how we should handle the naming of files that will be zipped, especially when we are unzipping the files that potentially have the same name or should replace the original files in the target directory. This can be solved in two different ways: 1) unzipping the files into a temporary directory, renaming them, then moving them into the final directory or 2) rename a file prior to zipping so it will be uniquely named when unzipped and thus can be renamed. Option 1 is more safe but requires creating a temporary directory & cleaning up, but when you have control over what the target directory will contain, option 2 is quite simple. In either approach, we can use VBA to rename a file as simply:
Name strUnzippedFile As strFinalFileName

Finally, when using Shell32, we are essentially automating the visual aspect of Windows Explorer. So when we invoke a “CopyHere”, it’s equivalent to actually dragging a file and dropping it in a folder (or a zip file). This also means it comes with UI components which may impose some issues, especially when we are automating the process. In this case, we need to wait until the compression has completed before taking any further actions. Because it’s an interactive action that occurs asynchronously, we must write waiting into our code. Monitoring an out-of-process compression can be tricky so we’ve developed a safeguard that covers different contingencies such as compression occurring too quickly or when there is a delay between compression dialog’s progress bar is filling up and it is closing. We do this in 3 different ways; a) timing out after 3 seconds for small files, b) monitoring the zip file’s item count, c) and monitoring the presence of compressing dialog. The last part requires us to use WScript.Shell object’s AppActivate method because unlike Access’ built-in AppActivate, WScript.Shell’s AppActivate will return a boolean value which we can be used to determine whether activation was successful or not, and thus implicate the presence/absence of the “Compressing…” dialog without a messy API handling.

Sample usage
The complete code is given below. To use it, the code would look something like this.
'Create a new zip file and zip a pdf file
Zip "C:TempMyNewZipFile.zip", "C:TempMyPdf.pdf

‘Unzip the pdf file and put it in the same directory as the Microsoft Access database
Unzip “C:TempMyNewZipFile.zip”

‘Example of zipping multiple files into single zip file
Zip “C:TempMyZipFile.zip”, “C:TempA1.pdf”
Zip “C:TempMyZipFile.zip”, “C:TempA2.pdf”
Zip “C:TempMyZipFile.zip”, “C:TempA3.pdf”

‘Unzipping a zip file with more than one file
‘placing them into a networked folder and
‘overwriting any pre-existing files
Unzip “C:TempMyZipFile.zip”, “Z:Shared Folder”, True
Here’s the complete Zip & Unzip procedure; simply copy’n’paste in a new VBA module and enjoy:
Private Declare Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As Long _
)

Public Sub Zip( _
ZipFile As String, _
InputFile As String _
)
On Error GoTo ErrHandler
Dim FSO As Object ‘Scripting.FileSystemObject
Dim oApp As Object ‘Shell32.Shell
Dim oFld As Object ‘Shell32.Folder
Dim oShl As Object ‘WScript.Shell
Dim i As Long
Dim l As Long

Set FSO = CreateObject(“Scripting.FileSystemObject”)
If Not FSO.FileExists(ZipFile) Then
‘Create empty ZIP file
FSO.CreateTextFile(ZipFile, True).Write _
“PK” & Chr(5) & Chr(6) & String(18, vbNullChar)
End If

Set oApp = CreateObject(“Shell.Application”)
Set oFld = oApp.NameSpace(CVar(ZipFile))
i = oFld.Items.Count
oFld.CopyHere (InputFile)

Set oShl = CreateObject(“WScript.Shell”)

‘Search for a Compressing dialog
Do While oShl.AppActivate(“Compressing…”) = False
If oFld.Items.Count > i Then
‘There’s a file in the zip file now, but
‘compressing may not be done just yet
Exit Do
End If
If l > 30 Then
‘3 seconds has elapsed and no Compressing dialog
‘The zip may have completed too quickly so exiting
Exit Do
End If
DoEvents
Sleep 100
l = l + 1
Loop

‘ Wait for compression to complete before exiting
Do While oShl.AppActivate(“Compressing…”) = True
DoEvents
Sleep 100
Loop

ExitProc:
On Error Resume Next
Set FSO = Nothing
Set oFld = Nothing
Set oApp = Nothing
Set oShl = Nothing
Exit Sub
ErrHandler:
Select Case Err.Number
Case Else
MsgBox “Error ” & Err.Number & _
“: ” & Err.Description, _
vbCritical, “Unexpected error”
End Select
Resume ExitProc
Resume
End Sub

Public Sub UnZip( _
ZipFile As String, _
Optional TargetFolderPath As String = vbNullString, _
Optional OverwriteFile As Boolean = False _
)
On Error GoTo ErrHandler
Dim oApp As Object
Dim FSO As Object
Dim fil As Object
Dim DefPath As String
Dim strDate As String

Set FSO = CreateObject(“Scripting.FileSystemObject”)
If Len(TargetFolderPath) = 0 Then
DefPath = CurrentProject.Path & “”
Else
If FSO.folderexists(TargetFolderPath) Then
DefPath = TargetFolderPath & “”
Else
Err.Raise 53, , “Folder not found”
End If
End If

If FSO.FileExists(ZipFile) = False Then
MsgBox “System could not find ” & ZipFile _
& ” upgrade cancelled.”, _
vbInformation, “Error Unziping File”
Exit Sub
Else
‘Extract the files into the newly created folder
Set oApp = CreateObject(“Shell.Application”)

With oApp.NameSpace(ZipFile & “”)
If OverwriteFile Then
For Each fil In .Items
If FSO.FileExists(DefPath & fil.Name) Then
Kill DefPath & fil.Name
End If
Next
End If
oApp.NameSpace(CVar(DefPath)).CopyHere .Items
End With

On Error Resume Next
Kill Environ(“Temp”) & “Temporary Directory*”

‘Kill zip file
Kill ZipFile
End If

ExitProc:
On Error Resume Next
Set oApp = Nothing
Exit Sub
ErrHandler:
Select Case Err.Number
Case Else
MsgBox “Error ” & Err.Number & “: ” & Err.Description, vbCritical, “Unexpected error”
End Select
Resume ExitProc
Resume
End Sub
An alternative using 3rd party resources

For those who would rather have more control over the process and do not mind including 3rd party utilities, Albert Kallal has a useful sample that allows a true programmatic access to the zipping/unzipping facility and requires no installment beyond copying the 2 DLLs file included wherever the front-end file goes. This is also useful if you do not want any UI components at all (e.g. allowing users to cancel the compression or click “No” to replacing file in a zip file).