1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to unzip folders from dir

Discussion in 'VBA Macros' started by Samadhan Gaikwad, Feb 2, 2017.

  1. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    Hi,

    I have dir. <C:\Users\a3rgcw\Downloads> containing many folders and each folder has zip file. I wanted to extract files from each folder and extract it at the same path of respective folder automatically without file browser.
    I went thru many sites and examples but none of them worked for this.
    Please help me!
    Thanks!
  2. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    Hi,

    I suspect you want it to complement this:
    http://forum.chandoo.org/threads/do...under-new-mentioned-folder.32885/#post-195597

    If so, you should have the folder names in column "A", in which case you don't need to loop through all the folders in the downloads folder, only those created by download code:
    Code (vb):
    Sub UnZipMe()

    Dim str_FILENAME As String, str_directory As String, str_DESTINATION As String
    Dim c As Range

    For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
        'Your directory where zip file is kept
       str_directory = "C:\Users\a3rgcw\Downloads\" & c.Value & "\"

        'Loop through all zip files in a given directory
       str_FILENAME = Dir(str_directory & "*.zip")
       
        Do While Len(str_FILENAME) > 0
            Call Unzip1(str_directory & str_FILENAME)
    '        Debug.Print str_FILENAME
           str_FILENAME = Dir
        Loop
    Next c

    End Sub

    Sub Unzip1(str_FILENAME As String)
        Dim oApp As Object
        Dim Fname As Variant
        Dim FnameTrunc As Variant
        Dim FnameLength As Long

        Fname = str_FILENAME
        FnameLength = Len(Fname)
        FnameTrunc = Left(Fname, FnameLength - 4) & "\"

        If Fname = False Then
            'Do nothing
       Else
            'Make the new folder in root folder
           MkDir FnameTrunc

    '        Extract the files into the newly created folder
           Set oApp = CreateObject("Shell.Application")
            oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items
        End If
    End Sub
    This should do it.

    Cheers
  3. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    You suspected it right.
    But with above code there is Run-time error '75': Path/File access error at MkDir FnameTrunc.

    Also folder with same name is created but it is empty.
  4. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    Hi,

    Replace previous codes (both download and unzip) with:
    Code (vb):
    Option Explicit

    Private Declare Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
    ByVal szURL As String, ByVal szFileName As String, _
    ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

    Dim Ret As Long

    '> This is where the files will be saved. Change as applicable
    Const FolderName As String = "C:\Users\a3rgcw\Downloads\"

    Sub Download()
        Dim ws As Worksheet
        Dim LastRow As Long, i As Long
        Dim strPath As String

        Set ws = Sheets("Sheet1")

        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

        For i = 1 To LastRow
               
            strPath = FolderName & "File" & i & ".zip"
            Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)

            If Ret = 0 Then
                ws.Range("C" & i).Value = "File successfully downloaded"
            Else
                ws.Range("C" & i).Value = "Unable to download the file"
            End If
     
        Next i
       
        UnZipMe

    End Sub

    Sub UnZipMe()

    Dim str_FILENAME As String, str_DESTINATION As String
    Dim c As Range

        'Loop through all zip files in the directory
       str_FILENAME = Dir(FolderName & "*.zip")
     
        Do While Len(str_FILENAME) > 0
            Call Unzip1(FolderName & str_FILENAME)
            str_FILENAME = Dir
        Loop

    End Sub

    Sub Unzip1(str_FILENAME As String)
        Dim oApp As Object
        Dim Fname As Variant
        Dim FnameTrunc As Variant
        Dim FnameLength As Long

        Fname = str_FILENAME
        FnameLength = Len(Fname)
        FnameTrunc = Left(Fname, FnameLength - 4) & "\"

        On Error Resume Next
        MkDir FnameTrunc
           
        'Extract the files into the folder
       Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items

        Kill Fname
    End Sub
    This will also delete the zip files after extraction... if you wish to keep the zip files simply delete "Kill Fname".

    Cheers
  5. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    With the above code zip files are downloaded but with renamed to File1.zip... instead of downloading it in respective folder. Also extraction does not work.
  6. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    Hi,

    My mistake,

    Replace
    Code (vb):
    strPath = FolderName & "File" & i & ".zip"
    with
    Code (vb):
    strPath = FolderName & ws.Range("A" & i).Value & ".zip"
    I forgot to change that :(

    Extraction should be working though... please test the attached file.
    It works here, let me know if it is working on your end.

    Attached Files:

  7. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    Thank you for your efforts. Now I can download folders but still extraction does not work, it is creating only empty folders and also one of the empty folder can not be deleted.
  8. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    Hi,

    That is odd... 3 questions:
    1) just to clarify, does that also happen with the sample file I uploaded?
    2) what is your office version?
    3) can you upload one or two of the links that are not working? - assuming it's not classified/sensitive! If not can you provide some other link with which the code creates the empty folder?

    The folder that can't be deleted is probably still in use by some process on your computer... if nothing else works, restarting the PC should fix it. Not sure what is causing it as it never happened here :confused:.
    Samadhan Gaikwad likes this.
  9. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    Hi,

    1) It does not happen with sample file, working good.
    2) I have MS Office 2010
    3) I can not share links as these are sensitive links but have added similar incorrect links.

    Also I have another issue where there is only one no. in A column but have many hyperlinks in B column. I need to add all zip files to that same PR no.
    Plz find attached file.

    Attached Files:

  10. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    Any help, just wanted to download data in one folder even when there are many links for same folder. Plz refer above file.
  11. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    Hi,
    I have got code modified from Stackoverflow, which appends string from B column and dump data into it. It would be great if it would be possible to download data in same folder name created from A column. Also would like to have files unzipped after downloading.

    Attached Files:

  12. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    Hi,

    Please refer to attachment...
    Sample file allows you to download multiple files into the same folder and creates new folders if necessary.

    I will now work on looping through all sub-folders to extract the ".zip" files.
    Will upload once finished.

    Attached Files:

    Samadhan Gaikwad likes this.
  13. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    Hi,

    Here you go...
    You need:
    Folder names in "A"
    Links in "B"
    File names in "C"

    Please test it and let me know if it is working as intended.

    Attached Files:

    Samadhan Gaikwad likes this.
  14. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    Thank you for looking into it.
    With your files, it is working fine. Bu when I replace hyperlinks with actual one, data for only first 2 or 3 links is downloaded. And then there is error: Run-time error '75'. Path/File access error at line: MkDir FolderName
  15. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    "MkDir FolderName" is the code that creates the folder. There is an if condition in place to check if the path already exists. It only creates the folder if it doesn't already exist.

    Did you fill columns A and C for each link in B?
    If you did, try adding:
    Code (vb):
    On error resume next
    at the beginning of the code. This will force the code to ignore the error and keep doing what it is supposed to do. After it finishes, analyse the folder structure and let me know what is missing.

    From there, I will try to figure out what is causing it.
    Samadhan Gaikwad likes this.
  16. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    Yeah, it is working as expected. Many files are dumped into one folder. Also there are many zip files having 1 KB size.
    1)So can we put status for them something else to indicate main folder is empty.
    2)And next thing will be unzipping files in main folder only.
  17. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    Hi,

    Please replace the "Download" sub code with the following:
    Code (vb):
    Sub Download()
        Dim ws As Worksheet
        Dim LastRow As Long, i As Long
        Dim strPath, FolderName As String

        Set ws = Sheets("Sheet1")

        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

        For i = 1 To LastRow
           
            FolderName = ParentFolderName & ws.Range("A" & i).Value & "\"
            If Dir(FolderName) = "" Then
                MkDir FolderName
            End If
         
            strPath = FolderName & ws.Range("C" & i).Value & ".zip"
            Ret = URLDownloadToFile(0, ws.Range("B" & i).Value, strPath, 0, 0)

            If Ret = 0 Then
                If Round(FileLen(strPath) / 1024, 2) > 1 Then
                    ws.Range("D" & i).Value = "File successfully downloaded"
                Else
                    ws.Range("D" & i).Value = "File size < 1KB"
                End If
            Else
                ws.Range("D" & i).Value = "Unable to download the file"
            End If
        Next i

        ExtractFiles

    End Sub
    You can set any value for the minimum size... as it is, all files downloaded with size < 1 KB will have the custom status "File size < 1KB".
    Change both minimum size and custom status as you see fit.

    If you wish to extract only the zip files located in "C:\Users\a3rgcw\Downloads\" and not the ones in the subfolders, then the "ExtractFiles" sub should read as follows:
    Code (vb):
    Sub ExtractFiles()

    Dim Fso As Object, objFolder As Object, oApp As Object
    Dim FromPath As String
    Dim FileInFolder As Object

    Set Fso = CreateObject("Scripting.filesystemobject")
    Set objFolder = Fso.GetFolder(ParentFolderName)

    For Each FileInFolder In objFolder.Files

        If InStr(1, FileInFolder.Name, ".zip") Then
            'Extract the files into the folder
           Set oApp = CreateObject("Shell.Application")
            oApp.Namespace(objFolder & "\").CopyHere oApp.Namespace(objFolder & "\" & FileInFolder.Name).items
         
            Kill FileInFolder
        End If

    Next FileInFolder

    End Sub
    Note that these subs are to be used in the full code provided earlier, by replacing the specific subroutines and not the whole code.
  18. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    Thank you. I will try it tomorrow. Just to let you know (I might have wrongly told you), I wanted to unzip each folder at their location only, like we use in 7 zip, extract to <file name/>.
  19. Monty

    Monty Well-Known Member

    Messages:
    721
    Samadhan Gaikwad and Arpanakumar like this.
  20. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    You are welcome ;)
  21. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    One more question what if I do not want to append any text to original file names. Tried but no success.
  22. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    Hi,

    As far as I know, and I'm no expert, downloading files through VBA requires a valid path. This includes the path to the folder and the name of the file, complete with extension.
    There are ways to request the file name from the service that is hosting it, but these methods are far from foul proof since they rely on that info being available.

    Not sure if that answered your question.
    If, however, you came across a different solution, specially if it allows you to not provide the name for the file, please let me know... I'm always eager to learn.

    Cheers
    Samadhan Gaikwad likes this.
  23. Samadhan Gaikwad

    Samadhan Gaikwad Member

    Messages:
    76
    I was speaking about file names in C column. I removed .zip extension from code and script is running fine. As one folder will not have any duplicate file name, so can we modify script from referring and using string from C column.
  24. PCosta87

    PCosta87 Well-Known Member

    Messages:
    870
    Hi,

    It is not throwing you any errors (and never will because of the "On error" statement) but the end result isn't the intended.

    Failing to provide the extension will have two effects (at least with the current code):
    1) Downloaded files will have no extension
    2) Macro will not unzip

    I may have explained myself incorrectly, before... you can indeed do without the file extension for the download part, if you are OK with having files with no extension. However, the script will not unzip afterwards, which was one of the requirements.

    Now, you can always remove the ".zip" from the "Download" code and add it in column C (or somewhere else for that matter). As long as that ends up as part of the string used as an argument of the "URLDownloadToFile" function, it will download and unzip as intended.

    About not having the file name in column C, you can always use a function to retrieve the file name from the link and use that instead of having the names in the worksheet.
    If this is what you meant, let me know and I will gladly try to help automate that.
    Samadhan Gaikwad likes this.

Share This Page