get-digital-help.com

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)
    .Show
    myfolder = .SelectedItems(1) & "\"
End With

With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    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
    Else
        If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        Else
            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
Loop

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