• 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...

  • 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

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!
 
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:
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
 
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.
 
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.
Hi,

Replace previous codes (both download and unzip) with:
Code:
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
 
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.
 
Hi,

My mistake,

Replace
Code:
strPath = FolderName & "File" & i & ".zip"
with
Code:
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.
 

Attachments

  • Download.xlsm
    21.8 KB · Views: 32
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.
 
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.
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:.
 
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.
 

Attachments

  • Download.xlsm
    22.4 KB · Views: 6
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.
 

Attachments

  • Download.xlsm
    19.9 KB · Views: 2
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.
 

Attachments

  • Download.xlsm
    22.1 KB · Views: 1
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.
 

Attachments

  • Download.xlsm
    23.2 KB · Views: 26
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
 
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
"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:
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.
 
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.
 
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.

Hi,

Please replace the "Download" sub code with the following:
Code:
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.

2)And next thing will be unzipping files in main folder only

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:
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.
 
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/>.
 
One more question what if I do not want to append any text to original file names. Tried but no success.
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
 
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.
 
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.
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.
 
Back
Top