http://accessexperts.net/blog/2012/02/06/zipandunzipfrommicrosoftvba/
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 Windows\System32 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:\Temp\MyNewZipFile.zip", "C:\Temp\MyPdf.pdf 'Unzip the pdf file and put it in the same directory as the Access database Unzip "C:\Temp\MyNewZipFile.zip" 'Example of zipping multiple files into single zip file Zip "C:\Temp\MyZipFile.zip", "C:\Temp\A1.pdf" Zip "C:\Temp\MyZipFile.zip", "C:\Temp\A2.pdf" Zip "C:\Temp\MyZipFile.zip", "C:\Temp\A3.pdf" 'Unzipping a zip file with more than one file 'placing them into a networked folder and 'overwriting any pre-existing files Unzip "C:\Temp\MyZipFile.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).