Author: Oscar Cronquist Article last updated on May 03, 2021

zip

The VBA macro demonstrated in this article lets you unzip all zip files in a folder to a destination folder you specify. It continues with subfolders until all zip files have been unzipped.

1. VBA Code

Actually, there are two macros. Run macro named UnzipFiles to start unzipping files.

'Name macro
Sub UnzipFiles()

'Dimension variables and declare data types
Dim myfolder As Variant
Dim destfolder As Variant

'Ask for a source folder
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show

    'Save selected folder path to variable myfolder
    myfolder = .SelectedItems(1) & "\"
End With

'Ask for a destination folder
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    destfolder = .SelectedItems(1) & "\"
End With

'Run macro named Recursive with parameters myfolder and destfolder
Call Recursive(myfolder, destfolder)

End Sub
'Name macro and dimension parameters
Sub Recursive(FolderPath As Variant, destfolder As Variant)

'Dimension variables and declare data types
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
Dim SApp As Object

'Redimension variable Folders
ReDim Folders(0)

'If...Then statement
'Check if last two characters are // and stop macro if true
If Right(FolderPath, 2) = "\\" Then Exit Sub

'Dir function returns a String representing the name of a file, directory, or folder, save string to variable Value
Value = Dir(FolderPath, &H1F)

'Do Until ... Loop statement
Keep iterating lines between Do Until and Loop
Do Until Value = ""

    'If ... Then ... Else ... Endif statement
    'Check if variable Value is equal to . or ..
    If Value = "." Or Value = ".." Then
    'Continue here if variable Value is not equal to . or ..
    Else
         
        'If ... Then ... Else ... Endif statement
        'Check if attribute for file is equal to 16 or 48 indicating it is a folder
        If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then

            'Save Folder name to variable Folders
            Folders(UBound(Folders)) = Value

            'Add another container to variable Folders, in other words, increase size of array variable Folders by 1
            ReDim Preserve Folders(UBound(Folders) + 1)

        'Continue here if attribute for file is equal to 16 or 48 indicating it is a folder
        Else

            'Check if last four characters in filename equals .zip
            If Right(Value, 4) = ".zip" Then

                'Unzip file to destination folder
                Set SApp = CreateObject("Shell.Application")
                SApp.Namespace(destfolder).CopyHere _
                SApp.Namespace(FolderPath & Value).items
            End If
        End If
    End If
    Value = Dir
Loop

'Start macro Recursive for each folder in variable Folders
For Each Folder In Folders
    Call Recursive(FolderPath & Folder & "\", destfolder)
Next Folder

End Sub

2. Where to put the code?

Unzip files in folder and subfolders VB Editor

  1. Press Alt + F11 to open the Visual Basic Editor (VBE).
  2. Click "Insert" on the top menu.
  3. Click "Module" to create a new module.
  4. Paste VBA code to code window.
  5. Exit VBE and return to Excel.

Note, save your workbook with file extension *.xlsm (macro-enabled workbook).

    1. Click "File" on the ribbon.
    2. Click "Save as...".
    3. Click on the drop-down list below the file name.
    4. Select file extension *.xlsm
    5. Click "Save".

3. How to run the macro?

Unzip files in folder and subfolders Macro dialog box

  1. Press Alt + F8 to open the Macro" dialog box.
  2. Click the macro name to select it.
  3. Click "Run" button.

4. What happens when you execute the macro?

  1. Select a folder you want to search.
  2. Select a destination folder. This is where all unzipped files will be copied to.
  3. Macro unzips all zip files in folder and subfolders.
  4. Macro ends.