<

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x

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

Published on
7,648 Points
3,648 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

The complete module and an Access 2106 file is here: Compress 1.1.1.zip

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

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

0
Comment
  • 2
4 Comments

Expert Comment

by:Geoffrey Smith
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).
0
LVL 55

Author Comment

by:Gustav Brock
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.
0

Expert Comment

by:Marc Zosiac
What about zipping two or more files in the same destination?
0
LVL 55

Author Comment

by:Gustav Brock
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.
0

Featured Post

Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Join & Write a Comment

Hi, this video explains a free download that you can incorporate into your Access databases, or use stand-alone for contact management. Contacts -- Names, Addresses, Phone Numbers, eMail Addresses, Websites, Lists, Projects, Notes, Attachments…
See the Basics of Office 365's Note Taking app, OneNote

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month