Unzip multiple folders to multiple folders

Question

My project involves downloading huge numbers of folders from a website, all of which are zipped, and then processing the data.

The macros I found for unzipping folders require specific paths to and from, while I need something that will unzip all of the folders within a specified folder - while keeping them organized by folder name. They can unzip to the same folder, they could even overwrite the zip file (in this case it wouldn't matter), but they must stay organized by folder name - otherwise the processing portion won't work.

I have two problems:
one - I have to select all the folders (to get paths), rather than just unzipping all the folders.
I tried modifying to run through each subfolder but it doesn't "see" zipped folders without a path, same issue with Dir().
two - it dumps all the unzipped files into a single destination, making it useless for processing.

A macro that does the same as right click, "extract all", but loops through all folders within a folder, would be perfect.

Sub Button11_Click()

    Dim IPath, OPath As String, FFile, FFSo, FFolder As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim Output_Folder As Variant
    Dim strDate As String
    Dim i As Long
    
    IPath = "E:\R2\Input\Zipped\"
    OPath = "E:\R2\Input\"
       
    'Select multiple zip files to unzip
    MsgBox "Go to E:\R2\Input\Zipped\ - For Zipped folders"
    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=True)
    
    If IsArray(Fname) = False Then
        'Do nothing
    Else
          
        'For Each SFolder In AFolder.Subfolders
          
        'Set output folder path for unzip files
        Output_Folder = OPath
             
        'Extract the files into output folder
        Set oApp = CreateObject("Shell.Application")

        For i = LBound(Fname) To UBound(Fname)
        
            'WORKS BUT DOESN"T SEPARATE INTO FOLDERS, just dumps into input folder.
            oApp.Namespace(Output_Folder).CopyHere oApp.Namespace(Fname(i)).items
    
        Next i
    
        MsgBox "You find the files here: " & Output_Folder
        
    End If
    
End Sub

Not to be rude, but it would be much appreciated if you could edit your text to be a more concise question https://stackoverflow.com/help/how-to-ask — Marcucciboy2, Aug 08 '18 at 16:32

iplayball27 · Answer 1 · 2021-02-08T22:21:03.183

There is a problem with cronos2546's answer in the Output_Folder = Mkdir OPath & "\" & Fname(i) line. This is invalid syntax.

What you need to do first is make Mkdir OPath & "\" i its own line. Then you'll want to do the assignment Output_Folder = OPath & "\" & iYou can't make a directory in the same line that you try to assign a directory (string). Additionally, Fname(i) is a complete path which will give you problems. I recommend changing Fname(i) to just i like I have in the beginning of this paragraph. This will simply number your folders.

Finally, @JMP883 you are getting a path error because the zip file output already has a folder with the same name in your output path. Make sure to delete or move all the contents in your output path before you try to run the macro each time.

score 0 · Answer 2 · answered Aug 08 '18 at 16:49

I think that this is what you're looking for. You basically make the directory each time you loop through the file names.

Else

    'For Each SFolder In AFolder.Subfolders

    'Set output folder path for unzip files
    'Output_Folder = OPath

    'Extract the files into output folder
    Set oApp = CreateObject("Shell.Application")

    For i = LBound(Fname) To UBound(Fname)
        'V Might need to update to "correct" name
        Output_Folder = Mkdir OPath & "\" & Fname(i)
        'WORKS BUT DOESN"T SEPARATE INTO FOLDERS, just dumps into input folder.
        oApp.Namespace(Output_Folder).CopyHere oApp.Namespace(Fname(i)).items

    Next i

    MsgBox "You find the files here: " & Output_Folder

End If

I modified those lines and got rid of the syntax error, but now the MkDir line gives me a path not found. 'Extract the files into output folder Set oApp = CreateObject("Shell.Application") For i = LBound(Fname) To UBound(Fname) OFolder = OPath & Fname(i) MkDir OFolder 'WORKS BUT DOESN"T SEPARATE INTO FOLDERS, just dumps into input folder. oApp.Namespace(OFolder).CopyHere oApp.Namespace(Fname(i)).items — JMP883, Aug 08 '18 at 17:25

Unzip multiple folders to multiple folders

2 Answers2