UnZip all files in specific folder

[Aswinraj]

Hello guys,
I have a code where it will unzip specific file based on file path provided. But I want to unzip all zip files present in the folder.

Public Sub Unzip()
    Dim localZipFile As Variant, destFolder As Variant  
    Dim Sh As Object
    localZipFile = "C:\folder\path\test.zip"
    destFolder = "C:\folder\path\" 
    Set Sh = CreateObject("Shell.Application")
    With Sh 
        .Namespace(destFolder).CopyHere .Namespace(localZipFile).Items
    End With
End Sub

 

[Domenic]

The following code does the following...

1) Checks whether the specified source folder contains at least one zip file. If not, it exits the sub.

2) Creates a temporary subfolder called "unzipped" within the specified folder in which to extract all of the zipped files.

3) Loops through each file within the specified source folder, and extracts files from all zipped files to the "unzipped" folder.

Note that I chose to declared zip_folder as a String instead of a Variant. As a consequence, I used the type conversion function CVar to convert zip_folder to a variant, which is required by Namespace...

shell_app.Namespace(CVar(zip_folder)).copyhere

Here's the code...

Option Explicit

Public Sub Unzip_All()

    Dim source_folder As String
    source_folder = "c:\users\domenic\desktop" 'change the path accordingly

    Dim current_zip_file As String
    current_zip_file = Dir(source_folder & "\*.zip")
   
    If Len(current_zip_file) = 0 Then
        MsgBox "No zip files found!", vbExclamation
        Exit Sub
    End If
   
    Dim zip_folder As String
    zip_folder = source_folder & "\unzipped"
   
    Dim error_message As String
    If Not create_temp_zip_folder(zip_folder, error_message) Then
        MsgBox error_message, vbCritical, "Error"
        Exit Sub
    End If

    Dim shell_app As Object
    Set shell_app = CreateObject("Shell.Application")
   
    Do While Len(current_zip_file) > 0
        shell_app.Namespace(CVar(zip_folder)).copyhere shell_app.Namespace(source_folder & "\" & current_zip_file).items
        current_zip_file = Dir
    Loop
   
    Set shell_app = Nothing
   
End Sub

Function create_temp_zip_folder(ByVal zip_folder As String, ByRef error_message As String) As Boolean

    On Error GoTo error_handler
   
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    If fso.FolderExists(zip_folder) Then
        fso.DeleteFolder zip_folder, True
    End If
   
    fso.CreateFolder zip_folder
   
    create_temp_zip_folder = True
   
    Set fso = Nothing
   
    Exit Function
   
error_handler:
    error_message = "Error " & Err.Number & ":" & vbCrLf & vbCrLf & Err.Description
   
End Function

Hope this helps!