Author: Oscar Cronquist Article last updated on July 29, 2017

This vba macro lets you search for zip files in a folder. Then unzip those files to a folder you specify. It continues with sub folders until all zip files have been unzipped.

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 sub folders.
  4. Macro ends.


VBA Code

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

Sub UnzipFiles()
Dim myfolder
Dim destfolder

With Application.FileDialog(msoFileDialogFolderPicker)
    myfolder = .SelectedItems(1) & "\"
End With

With Application.FileDialog(msoFileDialogFolderPicker)
    destfolder = .SelectedItems(1) & "\"
End With

Call Recursive(myfolder, destfolder)

End Sub
Sub Recursive(FolderPath As Variant, destfolder As Variant)
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
Dim SApp As Object

ReDim Folders(0)

If Right(FolderPath, 2) = "\\" Then Exit Sub
Value = Dir(FolderPath, &H1F)

Do Until Value = ""
    If Value = "." Or Value = ".." Then
        If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
            If Right(Value, 4) = ".zip" Then
                Set SApp = CreateObject("Shell.Application")
                SApp.Namespace(destfolder).CopyHere _
                SApp.Namespace(FolderPath & Value).items
            End If
        End If
    End If
    Value = Dir

For Each Folder In Folders
    Call Recursive(FolderPath & Folder & "\", destfolder)
Next Folder

End Sub

Download excel *.xlsm file

Unzip files in folder and subfolders.xlsm