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

Gustav BrockMVP
CERTIFIED EXPERT
Published:
Updated:
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 to 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; 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  and archive 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

Handle archive 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
'
' 2022-04-20. 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
    ' Native error numbers
    Const ErrorFileNotFound As Long = 53
    Const ErrorFileExists   As Long = 58
    Const ErrorNoPermission As Long = 70
    Const ErrorPathFile     As Long = 75
    ' Custom error numbers.
    Const ErrorOther        As Long = -1
    Const ErrorNone         As Long = 0
    ' Maximum (arbitrary) allowed count of created zip versions.
    Const MaxZipVersion     As Integer = 1000
    
    Dim IsRemovableDrive    As Boolean
    Dim Counter             As Long
    Dim Extension           As String
    Dim ExtensionName       As String
    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 or fileshare.
        ZipBase = FileSystemObject.GetBaseName(Path)
        If ZipBase <> "" Then
            ' Path is a folder.
            ZipName = ZipBase & ZipExtension
            ZipPath = FileSystemObject.GetFolder(Path).ParentFolder
        Else
            ' Path is a fileshare, thus has no parent folder.
        End If
    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
                If FileSystemObject.FolderExists(Destination) Then
                    ZipPath = Destination
                Else
                    ' No folder for the zip file. Exit.
                    Destination = ""
                End If
            Else
                ' Destination is a file.
                ZipName = FileSystemObject.GetFileName(Destination)
                ZipPath = FileSystemObject.GetParentFolderName(Destination)
                If ZipPath = "" Then
                    ' No target folder specified. Use the folder of the source.
                    ZipPath = FileSystemObject.GetParentFolderName(Path)
                End If
            End If
        Else
            ' Use the already found folder of the source.
            Destination = ZipPath
        End If
    End If
        
    If Destination <> "" Then
        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)
                ExtensionName = FileSystemObject.GetExtensionName(ZipFile)
                Extension = "." & ExtensionName
                
                ' 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\)") & Extension)
                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
        ' Set returned file name.
        Destination = ZipFile
    
        IsRemovableDrive = (FileSystemObject.GetDrive(FileSystemObject.GetDriveName(ZipPath)).DriveType = Removable)
        If Not IsRemovableDrive Then
            ' Check that the file/folder doesn't live on a linked drive.
            IsRemovableDrive = IsFolderAlias(ZipPath)
        End If
        
        ' Create a temporary zip name to allow for a final destination file with another extension than zip.
        If IsRemovableDrive Then
            ZipTemp = FileSystemObject.BuildPath(FileSystemObject.GetSpecialFolder(TemporaryFolder), FileSystemObject.GetBaseName(FileSystemObject.GetTempName()) & ZipExtension)
        Else
            ZipTemp = FileSystemObject.BuildPath(ZipPath, FileSystemObject.GetBaseName(FileSystemObject.GetTempName()) & ZipExtension)
        End If
        ' 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 . ";
            DoEvents
            .Namespace(CVar(ZipTemp)).CopyHere CVar(Path)
            DoEvents
            ' 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 Or Counter = 10
                ' Wait a little ...
                Sleep 50
                Debug.Print ".";
                DoEvents
                Counter = Counter + 1
            Loop
            Debug.Print Counter
            
            ' Resume normal error handling.
            On Error GoTo 0
            Debug.Print Timer, "Zipping finished."
        End With

        ' Copy (Rename) the temporary zip to its final name.
        On Error Resume Next
        Do
            DoEvents
            FileSystemObject.MoveFile ZipTemp, ZipFile
            Debug.Print Str(Err.Number);
            Sleep 50
            Select Case Err.Number
                Case ErrorFileExists, ErrorNoPermission
                    ' Continue.
                Case Else
                    ' Unexpected error.
                    Exit Do
            End Select
            ' Expected error; file has been moved.
        Loop Until Err.Number = ErrorFileNotFound
        On Error GoTo 0
        Debug.Print
        Debug.Print Timer, "Moving finished."
    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 . ";
            DoEvents
            .Namespace(CVar(ZipTemp)).CopyHere CVar(Path)
            DoEvents
            ' 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 Or Counter = 10
                ' Wait a little ...
                Sleep 50
                Debug.Print ".";
                DoEvents
                Counter = Counter + 1
            Loop
            Debug.Print Counter
            
            ' 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)
ExtensionName = FileSystemObject.GetExtensionName(ZipFile)
Extension = "." & ExtensionName

' 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\)") & Extension)
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:
'   Unpack 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
'
' 2023-10-28. 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"
    ' Extension of an archive file holding one or more files.
    Const TarExtensionName  As String = "tar"
    ' Extension of a compressed archive file holding one or more files.
    Const TgzExtensionName  As String = "tgz"
    ' Mandatory extension of zip file.
    Const ZipExtensionName  As String = "zip"
    Const ZipExtension      As String = "." & ZipExtensionName
    
    ' Constants for Shell.Application.
    Const DoOverwrite       As Long = &H0&
    Const NoOverwrite       As Long = &H8&
    Const YesToAll          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 Options             As Variant
    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) = TarExtensionName Or _
                FileSystemObject.GetExtensionName(Destination) = TgzExtensionName Or _
                FileSystemObject.GetExtensionName(Destination) = ZipExtensionName Then
                ' Do not unzip to a folder named *.cab, *.tar, 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.
            If OverWrite Then
                Options = DoOverwrite Or YesToAll
            Else
                Options = NoOverwrite Or YesToAll
            End If
            ShellApplication.Namespace(CVar(Destination)).CopyHere ShellApplication.Namespace(CVar(ZipTemp)).Items, Options
            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, Options

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

The complete module and Microsoft Access and Excel 365 files are here: Compress 1.3.0.zip

They will run in both 32- and 64-bit VBA.

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


I hope you found this article useful. You are encouraged to ask questions, report any bugs or make any other comments about it below.


Note: If you need further "Support" about this topic, please consider using the Ask a Question feature of Experts Exchange. I monitor questions asked and would be pleased to provide any additional support required in questions asked in this manner, along with other EE experts.


Please do not forget to press the "Thumbs Up" button if you think this article was helpful and valuable for EE members.


2
17,678 Views
Gustav BrockMVP
CERTIFIED EXPERT

Comments (4)

Thanks for putting this together.  I tried implementing in Excel and there seems to be a difference in the way that the FileSystemObject.OpenTextFile function works.  The parameter "ForWriting" is not valid in Excel; and need to specify 8 (which allows for appending to file).
CERTIFIED EXPERT
Most Valuable Expert 2015
Distinguished Expert 2023

Author

Commented:
Geoffrey, that is correct. I've updated the code at GitHub, but some error prohibits upload of a zip file to the article here.
It will be resolved shortly, I guess.
What about zipping two or more files in the same destination?
CERTIFIED EXPERT
Most Valuable Expert 2015
Distinguished Expert 2023

Author

Commented:
You mean into the same destination?
That it cannot do. That would require an array or collection to be passed as parameter and/or acceptance of wildcards.

But you could copy the files to a temp folder, then zip that folder to the location where you wish the zip to be finally located - though that zip would contain the temp folder and its files.

I'll add it to my (long) to-do list.

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.