Tested in Excel 365 (16.8730.2046) 64-bit. All links open in new tab.
Note: This macro doesn’t go through sub-folders. It s similar to using IzArc: select all files and right-click => Extract here… or Extract each archive in separate folder…
- Public Sub UnZipAll()
- Dim MyFile As String, MyFolder As String, DestinationFolder As String
- 'the folder where zip file is
- MyFolder = PickFileOrFolder(0)
- 'Loop through all zip files in a given directory
- MyFile = Dir(MyFolder & "\*.zip")
- Do While Len(MyFile) > 0
- Call UnzipIt(MyFolder & "\" & MyFile, 0)
- Debug.Print MyFile
- MyFile = Dir
- Loop
- End Sub
- '
- Public Sub UnzipIt(ZipFile As String, Optional NewPath As Boolean = False)
- Dim oApp As Object
- Dim FileName, FilePath, NewFilePath
- FileName = ZipFile
- If NewPath Then
- 'optional, extract to a subfolder having the same name as the file
- FilePath = Left(FileName, Len(FileName) - 4) & "\"
- MkDir FilePath
- Else
- FilePath = Left(FileName, InStrRev(FileName, "\"))
- End If
- If FileName <> "" Then
- 'Extract the files into the selected folder
- Set oApp = CreateObject("Shell.Application")
- oApp.Namespace(FilePath).CopyHere oApp.Namespace(FileName).items
- End If
- End Sub
PickFileOrFolder function is here