Unzipping files from Folder through Macro

[aravindkm]

Hi All,

Could anyone please help me with a code to unzip the folder using VBA.

Since I have around 130 files which needs unzipping on a monthly to do reconciliation which takes more than 5 hours for me to Unzip and paste the data into a excel sheet.

Thanks

 

[ParamRay]

Re: Need Help in Unziping files from Folder through Macro (VBA)

Here's one way to automate the zip-file extraction:

' Add references via Tools --> References:
' 1) Microsoft Shell Controls And Automation
' 2) Microsoft Scripting Runtime
' 3) Microsoft Office xx.x Object Library

Public Sub UnzipFiles()
  On Error GoTo ErrHandler
  Dim objFileSystem As New Scripting.FileSystemObject
  Dim objFileDialog As Office.FileDialog
  Dim objShell As New Shell32.Shell
  Dim astrFilePaths() As String
  Dim strFullFolder As String
  Dim strTopFolder As String
  Dim strSubfolder As String
  Dim intNumFiles As Integer
  Dim blnErrors As Boolean
  Dim i As Integer
  
' Present user with multi-select file dialog
' to select the zip files for processing:

  Set objFileDialog = Application.FileDialog(msoFileDialogOpen)
  With objFileDialog
    .Title = "Select Files to Unzip"
    .AllowMultiSelect = True
    .InitialFileName = ThisWorkbook.Path & "\"
    .Filters.Clear
    .Filters.Add "Zip Files", "*.zip"
    .ButtonName = "Unzip"
    If .Show Then
      intNumFiles = .SelectedItems.Count
      ReDim astrFilePaths(1 To intNumFiles)
      For i = 1 To intNumFiles
        astrFilePaths(i) = .SelectedItems(i)
      Next i
    Else
      GoTo ExitProc
    End If
  End With
  
' Create new directory for the extracted files
  strTopFolder = objFileSystem.GetFile(astrFilePaths(1)).ParentFolder.Path & "\Extracted Files\"
  If Not objFileSystem.FolderExists(strTopFolder) Then
    objFileSystem.CreateFolder strTopFolder
  End If
  
' Extract files to the new directory
  For i = 1 To intNumFiles
    strSubfolder = objFileSystem.GetBaseName(astrFilePaths(i)) & "\"
    strFullFolder = strTopFolder & strSubfolder
    If Not objFileSystem.FolderExists(strFullFolder) Then
      objFileSystem.CreateFolder strFullFolder
    End If
    
    On Error Resume Next
    objShell.Namespace(strFullFolder).CopyHere objShell.Namespace(astrFilePaths(i)).Items
    If Err.Number <> 0 Then blnErrors = True
    On Error GoTo ErrHandler
  Next i
  
' Notify user of results
  MsgBox Format(intNumFiles, "#,0") & " zip files were extracted with " _
       & IIf(blnErrors, "some", "no") & " errors to this location:" _
       & vbCrLf & vbCrLf & strTopFolder, vbInformation
  
' Show the extracted files in file explorer
  objShell.ShellExecute "explorer.exe", strTopFolder
  
ExitProc:
  Set objFileSystem = Nothing
  Set objFileDialog = Nothing
  Set objShell = Nothing
  Exit Sub
  
ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitProc
End Sub

 

[ParamRay]

Re: Need Help in Unziping files from Folder through Macro (VBA)

Just wanted to check what the performance was like when processing 130 files...

 

[resulter]

Re: Need Help in Unziping files from Folder through Macro (VBA)

Hello ParamRay,
I am wondering how is it possible that your code is working for me even though the variable array astrFilePaths is declared as string? I am trying so hard to make my code below running and I can't figure out why I am getting Run-time error 91!

My variables are declared as variants (as they should be), the paths are correct and folders are created.

The purpose of this code is to ask for folder with zipped files and then extract all ZIP files into the existing path e.g. "c:\test\NEW_PROJECT"

Sub create_new_project()
    Dim oApp As Object
    Dim FolderWithZipFiles As Variant
    Dim UnzipedDirPath  As Variant
    Dim ProjectPath As Variant
    Dim ZipName As Variant
    Dim ZipPath As Variant
    
    ProjectPath = "c:\test\"
    UnzipedDirPath = ProjectPath & "NEW_PROJECT\"
    FolderWithZipFiles = GetFolder
    
    ZipName = Dir(FolderWithZipFiles & "\*.zip")
    Do While ZipName <> ""
        ZipPath = FolderWithZipFiles & "\" & ZipName
        
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(UnzipedDirPath).CopyHere oApp.Namespace(ZipPath).Items
    Loop
End Sub
Function GetFolder(Optional strPath As String) As Variant
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Choose a folder with ZIPed analyzes"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Can anyone help me please? I spent few hours solving why the hell I get the Run-time 91 error. Thanks a lot!

 

[Jeff Tome]

Re: Need Help in Unziping files from Folder through Macro (VBA)

ParamRay - Thank you for your code submission! it is so quick. I had to remove "Notify user of results" msgbox to get the code to run. It is giving me a compile error: expected array. All of my tool references are loaded. Will you comment why this may not be working for me? Thank you

 

[Jeff Tome]

Re: Need Help in Unziping files from Folder through Macro (VBA)

It does 421 Files, 7 Folders, 37Mb, in about 8 seconds.