<

Zip and unzip files and folders with VBA the Windows Explorer way

Published on
4,430 Points
430 Views
Last Modified:
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc.
In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.

Ease of use

There are many uses for zip folders. Previously, saving disk space was the primary purpose, but today that often isn't very important; more the option for collecting a selection of files in one file may be more pertinent.

However, for whatever reason or purpose you may have for using a zip folder (or a file as it physically is) that is controlled by VBA code in, say, Microsoft Excel or Microsoft Access, it should be easy to manage. 


Several external third-party tools and libraries are offered, and each may have certain advantages, but for the general usage - reading and writing zip folders as Windows Explorer does - you only need the two functions presented here: Zip and Unzip - nothing more, nothing less.


Note: Cabinet  files/folders can be managed in similar ways. If you are interested in this, please see:
Handle cabinet files and folders with VBA the Windows Explorer way


Zip and Unzip

These two functions are included in the code and does just that in a way that - by default - matches the result as if you did it manually onscreen using Windows Explorer. 

They can do a little more, controlled by the parameters as explained below, and will also work with custom file extensions, should you have the need. Thus, a zip folder may be named, say, myzipfolder.baz . This will prevent the file from being recognized by Windows Explorer as a zip folder.


For large and/or many files, the well-known progress bar box will be displayed.


Zip

Result = Zip(Path)

This zips Path  (a file or a folder) as if you, in Windows Explorer, right-click the file/folder and select Send to zip compressed folder. Result holds 0 (zero) if success, or an error code.


For many practical purposes, you also wish to specify where  the zip folder will be created and/or what name it should be given. Thus:

Destination = "D:\Backups\Data_20171224.zip"
Result = Zip(Path, Destination)

Should you wish so, the extension can be different from zip, for example:

Destination = "D:\Backups\Data_20171224.zap"


Also you are probably aware, that if you, in Windows Explorer, tries to zip a file/folder once more, Windows Explorer will generate a "versioned" zip file, like:

D:\Backups\Data_20171224.zip
D:\Backups\Data_20171224 (2).zip
D:\Backups\Data_20171224 (3).zip

and so on - and so will Zip do. 

If you don't want this, a third parameter is available, Overwrite. Thus, if the destination exists:

Result = Zip(Path, , True)     ' Delete and recreate the zip folder.
Result = Zip(Path, , False)    ' Create a versioned zip folder.


UnZip

Result = UnZip(Path)

This unzips Path  (a zip folder) as if you, in Windows Explorer, right-click the zip folder and select Unzip all.... Result holds 0 (zero) if success, or an error code.


Often, you wish to specify where  the zip folder will be unzipped and/or what name the folder should be given. If so, specify the Destination parameter:

Destination = "D:\Restore\Data"
Result = UnZip(Path, Destination)


By default, if unzipping to an existing folder, UnZip will leave existing other files, but overwrite those named as the files in the zip folder. Setting parameter Overwrite to True, will overwrite the existing folder completely:

Result = UnZip(Path, , True)     ' Delete and recreate the folder.
Result = UnZip(Path, , False)    ' Leave existing files in the folder.

Warning

Be careful and double-check before calling UnZip with Overwrite set to True.

If Destination is specified incorrectly, you may inadvertently erase most of a drive.


Code

Both Zip and UnZip takes advantage of two standard Microsoft libraries found on any Windows machine:


     Microsoft Shell Controls And Automation

     Microsoft Scripting Runtime


and both functions allow for early  or late binding  as you prefer, controlled by the constant EarlyBinding that you can adjust to your preference.


There are many more details to take care of than one might expect, thus a lot of comments are outlined here to study for those that are interested. But don't feel obliged; the functions are ready to use as is.


Zip

This is the full function:

' Zip a file or a folder to a zip file/folder using Windows Explorer.
' Default behaviour is similar to right-clicking a file/folder and selecting:
'   Send to zip file.
'
' Parameters:
'   Path:
'       Valid (UNC) path to the file or folder to zip.
'   Destination:
'       (Optional) Valid (UNC) path to file with zip extension or other extension.
'   Overwrite:
'       (Optional) Leave (default) or overwrite an existing zip file.
'       If False, the created zip file will be versioned: Example.zip, Example (2).zip, etc.
'       If True, an existing zip file will first be deleted, then recreated.
'
'   Path and Destination can be relative paths. If so, the current path is used.
'
'   If success, 0 is returned, and Destination holds the full path of the created zip file.
'   If error, error code is returned, and Destination will be zero length string.
'
' Early binding requires references to:
'
'   Shell:
'       Microsoft Shell Controls And Automation
'
'   Scripting.FileSystemObject:
'       Microsoft Scripting Runtime
'
' 2017-10-22. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function Zip( _
    ByVal Path As String, _
    Optional ByRef Destination As String, _
    Optional ByVal Overwrite As Boolean) _
    As Long
   
#If EarlyBinding Then
    ' Microsoft Scripting Runtime.
    Dim FileSystemObject    As Scripting.FileSystemObject
    ' Microsoft Shell Controls And Automation.
    Dim ShellApplication    As Shell
   
    Set FileSystemObject = New Scripting.FileSystemObject
    Set ShellApplication = New Shell
#Else
    Dim FileSystemObject    As Object
    Dim ShellApplication    As Object
    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set ShellApplication = CreateObject("Shell.Application")
#End If
   
    ' Mandatory extension of zip file.
    Const ZipExtensionName  As String = "zip"
    Const ZipExtension      As String = "." & ZipExtensionName
    ' Custom error values.
    Const ErrorPathFile     As Long = 75
    Const ErrorOther        As Long = -1
    Const ErrorNone         As Long = 0
    ' Maximum (arbitrary) allowed count of created zip versions.
    Const MaxZipVersion     As Integer = 1000
   
    Dim ZipHeader           As String
    Dim ZipPath             As String
    Dim ZipName             As String
    Dim ZipFile             As String
    Dim ZipBase             As String
    Dim ZipTemp             As String
    Dim Version             As Integer
    Dim Result              As Long
   
    If FileSystemObject.FileExists(Path) Then
        ' The source is an existing file.
        ZipName = FileSystemObject.GetBaseName(Path) & ZipExtension
        ZipPath = FileSystemObject.GetFile(Path).ParentFolder
    ElseIf FileSystemObject.FolderExists(Path) Then
        ' The source is an existing folder.
        ZipName = FileSystemObject.GetBaseName(Path) & ZipExtension
        ZipPath = FileSystemObject.GetFolder(Path).ParentFolder
    Else
        ' The source does not exist.
    End If
       
    If ZipName = "" Then
        ' Nothing to zip. Exit.
        Destination = ""
    Else
        If Destination <> "" Then
            If FileSystemObject.GetExtensionName(Destination) = "" Then
                ' Destination is a folder.
                ZipPath = Destination
            Else
                ' Destination is a file.
                ZipName = FileSystemObject.GetFileName(Destination)
                ZipPath = FileSystemObject.GetParentFolderName(Destination)
            End If
        Else
            ' Use the already found folder of the source.
        End If
        ZipFile = FileSystemObject.BuildPath(ZipPath, ZipName)
        If FileSystemObject.FileExists(ZipFile) Then
            If Overwrite = True Then
                ' Delete an existing file.
                FileSystemObject.DeleteFile ZipFile, True
                ' At this point either the file is deleted or an error is raised.
            Else
                ZipBase = FileSystemObject.GetBaseName(ZipFile)
                ' Modify name of the zip file to be created to preserve an existing file:
                '   "Example.zip" -> "Example (2).zip", etc.
                Version = Version + 1
                Do
                    Version = Version + 1
                    ZipFile = FileSystemObject.BuildPath(ZipPath, ZipBase & Format(Version, " \(0\)") & ZipExtension)
                Loop Until FileSystemObject.FileExists(ZipFile) = False Or Version > MaxZipVersion
                If Version > MaxZipVersion Then
                    ' Give up.
                    Err.Raise ErrorPathFile, "Zip Create", "File could not be created."
                End If
            End If
        End If
   
        ' Create a temporary zip name to allow for a final destination file with another extension than zip.
        ZipTemp = FileSystemObject.BuildPath(ZipPath, FileSystemObject.GetBaseName(FileSystemObject.GetTempName()) & ZipExtension)
        ' Create empty zip folder.
        ' Header string provided by Stuart McLachlan <stuart@lexacorp.com.pg>.
        ZipHeader = Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, vbNullChar)
        With FileSystemObject.OpenTextFile(ZipTemp, ForWriting, True)
            .Write ZipHeader
            .Close
        End With
       
        ' Resolve relative paths.
        ZipTemp = FileSystemObject.GetAbsolutePathName(ZipTemp)
        Path = FileSystemObject.GetAbsolutePathName(Path)
        ' Copy the source file/folder into the zip file.
        With ShellApplication
            Debug.Print Timer, "Zipping started . ";
            .Namespace(CVar(ZipTemp)).CopyHere CVar(Path)
            ' Ignore error while looking up the zipped file before is has been added.
            On Error Resume Next
            ' Wait for the file to created.
            Do Until .Namespace(CVar(ZipTemp)).Items.Count = 1
                ' Wait a little ...
                Sleep 50
                Debug.Print ".";
            Loop
            Debug.Print
            ' Resume normal error handling.
            On Error GoTo 0
            Debug.Print Timer, "Zipping finished."
        End With
        ' Rename the temporary zip to its final name.
        FileSystemObject.MoveFile ZipTemp, ZipFile
    End If
   
    Set ShellApplication = Nothing
    Set FileSystemObject = Nothing
   
    If Err.Number <> ErrorNone Then
        Destination = ""
        Result = Err.Number
    ElseIf Destination = "" Then
        Result = ErrorOther
    End If
   
    Zip = Result
End Function

It is heavily commented in-line, but the key points are:


  1. Verifies the source
  2. Verifies the destination
  3. Copies the files
  4. Performs clean-up


The core code is this (shortened) which copies the file(s) into the zip folder:

        With ShellApplication
            .Namespace(CVar(ZipTemp)).CopyHere CVar(Path)
        End With


A problem here is, however, that after calling this, our code would just continue, while - as you know - zipping a lot of files can take some time, and we have some clean-up to do afterwards.


Thus, it is necessary to put in a loop that regularly checks if the zip folder is ready and, only when it is, to continue.

This is shown here, where the Sleep function in the Do Until ... Loop  inserts a tiny delay which will be repeated over and over until the zip folder is ready:


        With ShellApplication
            Debug.Print Timer, "Zipping started . ";
            .Namespace(CVar(ZipTemp)).CopyHere CVar(Path)
            ' Ignore error while looking up the zipped file before is has been added.
            On Error Resume Next
            ' Wait for the file to created.
            Do Until .Namespace(CVar(ZipTemp)).Items.Count = 1
                ' Wait a little ...
                Sleep 50
                Debug.Print ".";
            Loop
            Debug.Print
            ' Resume normal error handling.
            On Error GoTo 0
            Debug.Print Timer, "Zipping finished."
        End With


In case parameter Overwrite  is False and the zip folder exists, a new file will be created and given a version number.

That is controlled by this loop:


ZipBase = FileSystemObject.GetBaseName(ZipFile)
' Modify name of the zip file to be created to preserve an existing file:
'   "Example.zip" -> "Example (2).zip", etc.
Version = Version + 1
Do
    Version = Version + 1
    ZipFile = FileSystemObject.BuildPath(ZipPath, ZipBase & Format(Version, " \(0\)") & ZipExtension)
Loop Until FileSystemObject.FileExists(ZipFile) = False Or Version > MaxZipVersion
If Version > MaxZipVersion Then
    ' Give up.
    Err.Raise ErrorPathFile, "Zip Create", "File could not be created."
End If

As you will see, a maximum count is used to prevent the loop from going on forever.


UnZip

This is the full function:

' Unzip files from a zip file to a folder using Windows Explorer.
' Default behaviour is similar to right-clicking a file/folder and selecting:
'   Unzip all ...
'
' Parameters:
'   Path:
'       Valid (UNC) path to a valid zip file. Extension can be another than "zip".
'   Destination:
'       (Optional) Valid (UNC) path to the destination folder.
'   Overwrite:
'       (Optional) Leave (default) or overwrite an existing folder.
'       If False, an existing folder will keep other files than those in the extracted zip file.
'       If True, an existing folder will first be deleted, then recreated.
'
'   Path and Destination can be relative paths. If so, the current path is used.
'
'   If success, 0 is returned, and Destination holds the full path of the created folder.
'   If error, error code is returned, and Destination will be zero length string.
'
' Early binding requires references to:
'
'   Shell:
'       Microsoft Shell Controls And Automation
'
'   Scripting.FileSystemObject:
'       Microsoft Scripting Runtime
'
' 2017-10-22. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function UnZip( _
    ByVal Path As String, _
    Optional ByRef Destination As String, _
    Optional ByVal Overwrite As Boolean) _
    As Long
   
#If EarlyBinding Then
    ' Microsoft Scripting Runtime.
    Dim FileSystemObject    As Scripting.FileSystemObject
    ' Microsoft Shell Controls And Automation.
    Dim ShellApplication    As Shell
   
    Set FileSystemObject = New Scripting.FileSystemObject
    Set ShellApplication = New Shell
#Else
    Dim FileSystemObject    As Object
    Dim ShellApplication    As Object
    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set ShellApplication = CreateObject("Shell.Application")
#End If
               
    ' Extension of a cabinet file holding one or more files.
    Const CabExtensionName  As String = "cab"
    ' Mandatory extension of zip file.
    Const ZipExtensionName  As String = "zip"
    Const ZipExtension      As String = "." & ZipExtensionName
    ' Constants for Shell.Application.
    Const OverWriteAll      As Long = &H10&
    ' Custom error values.
    Const ErrorNone         As Long = 0
    Const ErrorOther        As Long = -1
   
    Dim ZipName             As String
    Dim ZipPath             As String
    Dim ZipTemp             As String
    Dim Result              As Long
   
    If FileSystemObject.FileExists(Path) Then
        ' The source is an existing file.
        ZipName = FileSystemObject.GetBaseName(Path)
        ZipPath = FileSystemObject.GetFile(Path).ParentFolder
    End If
   
    If ZipName = "" Then
        ' Nothing to unzip. Exit.
        Destination = ""
    Else
        ' Select or create destination folder.
        If Destination <> "" Then
            ' Unzip to a custom folder.
            If _
                FileSystemObject.GetExtensionName(Destination) = CabExtensionName Or _
                FileSystemObject.GetExtensionName(Destination) = ZipExtensionName Then
                ' Do not unzip to a folder named *.cab or *.zip.
                ' Strip extension.
                Destination = FileSystemObject.BuildPath( _
                    FileSystemObject.GetParentFolderName(Destination), _
                    FileSystemObject.GetBaseName(Destination))
            End If
        Else
            ' Unzip to a subfolder of the folder of the zipfile.
            Destination = FileSystemObject.BuildPath(ZipPath, ZipName)
        End If
           
        If FileSystemObject.FolderExists(Destination) And Overwrite = True Then
            ' Delete the existing folder.
            FileSystemObject.DeleteFolder Destination, True
        End If
        If Not FileSystemObject.FolderExists(Destination) Then
            ' Create the destination folder.
            FileSystemObject.CreateFolder Destination
        End If
       
        If Not FileSystemObject.FolderExists(Destination) Then
            ' For some reason the destination folder does not exist and cannot be created.
            ' Exit.
            Destination = ""
        Else
            ' Destination folder existed or has been created successfully.
            ' Resolve relative paths.
            Destination = FileSystemObject.GetAbsolutePathName(Destination)
            Path = FileSystemObject.GetAbsolutePathName(Path)
            ' Check file extension.
            If FileSystemObject.GetExtensionName(Path) = ZipExtensionName Then
                ' File extension is OK.
                ZipTemp = Path
            Else
                ' Rename the zip file by adding a zip extension.
                ZipTemp = Path & ZipExtension
                FileSystemObject.MoveFile Path, ZipTemp
            End If
            ' Unzip files and folders from the zip file to the destination folder.
            ShellApplication.Namespace(CVar(Destination)).CopyHere ShellApplication.Namespace(CVar(ZipTemp)).Items, OverWriteAll
            If ZipTemp <> Path Then
                ' Remove the zip extension to restore the original file name.
                FileSystemObject.MoveFile ZipTemp, Path
            End If
        End If
    End If
   
    Set ShellApplication = Nothing
    Set FileSystemObject = Nothing
   
    If Err.Number <> ErrorNone Then
        Destination = ""
        Result = Err.Number
    ElseIf Destination = "" Then
        Result = ErrorOther
    End If
   
    UnZip = Result
     
End Function


Again, the in-line comments should make it possible to follow its doings, but in essence it performs these steps:


  1. Verifies the source
  2. Verifies the destination
  3. Copies the files
  4. Performs clean-up


Again, the core code is quite simple; it copies the content of the source - the zip folder - into the destination folder:

    ShellApplication.Namespace(CVar(Destination)).CopyHere ShellApplication.Namespace(CVar(ZipTemp)).Items, OverWriteAll

Contrary to the copying to a zip folder (above), this code waits for the copying to finish, and will not continue until copying is done.


Conclusion

Armed with these two functions, you can control all basic zipping and unzipping from VBA. No external tools or libraries are used, which makes distributing and deployment easy. 

Of course, more advanced options, like encrypting, may be requested, and then third-party tools like WinZip  or 7Zip  must be used. But this will be more about zip files  while we here discuss zip folders  as we know them from Windows.


Files and download

An Access 2106 file with the complete module is here: Compress 1.0.2.zip

Current files can always be found at: GitHub VBA.Compress

0
Comment
0 Comments

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Join & Write a Comment

This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month