VBA Zip/Unzip/Compress/Extract

The following was built out of personal need to add the ability to compress files within a project I was working on and thought it might serve others.

I built my example around 7-Zip, specifically its command line executable (7za.exe).  Simply visit their website and download the latest copy and then place the 7za.exe in a subfolder of the current database (it does not require any installation!, just copy/paste).  Then edit the s7ZipDir variable in the code below to reflect your setup and use the code.

There are usage examples provided with each function.

For Zipping, you can call the Zip function for multiple files on the same archive to add them to the same archive, but you must wait for the previous file to have finished being compressed prior to trying to add another one.

'***************************************************************************************
'7-Zip is licensed under the GNU LGPL license
'
'7-Zip Home (downloads, source code, ...)
'*****************************************
'   http://www.7-zip.org/
'***************************************************************************************

Private Const sModName = "mod_7-Zip_CmdLine" 'Application.VBE.ActiveCodePane.CodeModule
Private Const s7ZipDir = "\Libraries\7-Zip\" 'This is where we place a copy of the 7za.exe
                                             '(a subfolder of the location of the current database


'---------------------------------------------------------------------------------------
' Procedure : Zip_ZipFile
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Add a File to a Zip file
'               If the Zip file does not exist, it will be created
'               If it already exists then the file will be added to the existing Zip file
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Req'd Refs: None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile      File to zip, fully qualified path and filename with extension
' sZipFile   Zip Archive, fully qualified path and filename with extension
' bDelsFile  Whether to delete the file to zip once added to the Zip Archive
' sPwd       Password to encrypt the file with
'
' Usage:
' ~~~~~~
' Zip_ZipFile "C:\Databases\Testing\Database7.accdb", "C:\Databases\Testing\Database7.zip"
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2017-04-05              Initial Release
'---------------------------------------------------------------------------------------
Public Function Zip_ZipFile(ByVal sFile As String, _
                            ByVal sZipFile As String, _
                            Optional bDelsFile As Boolean = False, _
                            Optional ByVal sPwd As Variant)
    On Error GoTo Error_Handler
    Dim sExePath              As String
    Dim sShellCmd             As String

    'Location of our command line 7-zip exe
    sExePath = Application.CurrentProject.Path & s7ZipDir
    '7-zip command
    ' " -mx7" is used to specify maximum compression.
    sShellCmd = "7za.exe a -tzip" & _
                " " & Chr(34) & sZipFile & Chr(34) & _
                " " & Chr(34) & sFile & Chr(34) & " -mx7"
    'Additional deletion command (if applicable)
    If bDelsFile = True Then sShellCmd = sShellCmd & " -sdel"
    If IsNull(sPwd) = False Then sShellCmd = sShellCmd & " -p" & sPwd
    Shell sExePath & sShellCmd

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    'LogError Err.Number, Err.Description, sModName & "\Zip_ZipFile", , True, Erl
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: " & sModName & "\Zip_ZipFile" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : Zip_UnZipFile
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Unzip/extract the contents of a Zip archive to a designated directory
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Req'd Refs: None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sZipFile   Zip Archive, fully qualified path and filename with extension
' sDestDir   Folder in which the extract the Zip archive's content
'
' Usage:
' ~~~~~~
' Zip_UnZipFile "C:\Databases\Testing\Database7.zip", "C:\Databases\Testing\"
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2017-04-05              Initial Release
'---------------------------------------------------------------------------------------
Public Function Zip_UnZipFile(ByVal sZipFile As String, ByVal sDestDir As String)
    On Error GoTo Error_Handler
    Dim sExePath              As String
    Dim sShellCmd             As String

    'Location of our command line 7-zip exe
    sExePath = Application.CurrentProject.Path & s7ZipDir
    '7-zip command
    sShellCmd = "7za.exe x" & _
                " " & Chr(34) & sZipFile & Chr(34) & _
                " -o" & Chr(34) & sDestDir & Chr(34)
    Shell sExePath & sShellCmd

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    'LogError Err.Number, Err.Description, sModName & "\Zip_ZipFile", , True, Erl
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: " & sModName & "\Zip_UnZipFile" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

 

5 responses on “VBA Zip/Unzip/Compress/Extract

  1. Jim

    I must be missing something….. I install 7-zip but there is no 7za.exe in the installation folder for either 32 or 64bit. I downloaded the latest copy of zip (2017) and an older copy (2016). However, it’s in neither. There is a 7z.exe and I tried that

    Error: 53
    Source: mod_7-Zip_ComdLine\Zip_ZipFile
    Desc: File not found

    Is it because I am zipping a text file

    Zip_ZipFile “C:\DMS_Behavior\test_files\Behavior-Frankfort-035-12301899-100008.txt”, “C:\C:\DMS_Behavior\test_files\Behavior-Frankfort-035-12301899-100008.zip”

    Yes, I updated the constants
    Private Const sModName = “mod_7zip_test” ‘Application.VBE.ActiveCodePane.CodeModule
    Private Const s7ZipDir = “\DMS_Behavior\7-zip\” ‘This is where we place a copy of the 7za.exe
    ‘(a subfolder of the location of the current database

  2. tom

    hi, daniel
    the above code works only if the current accdb is not opened. maybe some file locking. ( i am using the code on the opened accdb and backing it while opened).

    Secondly how to check if backup was successful or not.

    regards.

    1. Daniel Pineault Post author

      Access does not truly allow hot backups. If you perform a backup while people are in it at the moment they are interacting with the data, you can end up with a corrupted database.

      When it comes to Access, you need to ensure there is no lock file present, thus no one using the database, before proceeding to perform a backup.

      As for validating the process, you can use Dir() to see if the backup file actually exists, but beyond that it is a manual task because proper validation require opening the file and checking the tables to ensure they are intact.