VBA script to Unzip Files - It's Just Creating Empty Folders

Question

I'm using the code by Ron (http://www.rondebruin.nl/win/s7/win002.htm) to, in theory, unzip a bunch of zip files in a folder. I believe what I have below is the code that takes each zip file in my 'Downloads' directory, creates a new folder with the name of the zip file without the ".zip", and then extracts the files into the new folder. I am not getting any errors (many times people get the runtime error 91) but the only thing that happens is that it creates a bunch of correctly named folders but they are all empty.

Sub UnZipMe()

Dim str_FILENAME As String, str_DIRECTORY As String, str_DESTINATION As String

'Your directory where zip file is kept
str_DIRECTORY = "C:\Users\Jennifer\Downloads\"

'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

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

score 1 · Answer 1 · answered Nov 06 '13 at 13:05

1

The problem is you are not giving windows enough time to extract the zip file. Add DoEvents after the line as shown below.

TRIED AND TESTED

    oApp.Namespace(FnameTrunc).CopyHere oApp.Namespace(Fname).items
    DoEvents

answered Nov 06 '13 at 13:05

Siddharth Rout

147,039
17
206
250

1

Thanks but that was not the problem. If I created a zip file on my own with files from my computer, the macro works fine with no change needed. We have isolated the problem to the way the zip file is downloaded from our CMS website. Here is the code: Download Photos where $photoLink = $_SERVER['PHP_SELF'] . '?action=photos&customization_id=' . $item['customization']['customization_id']; This downloads a zip file to my computer that when double clicked, gives the following error: Windows cannot open the folder. The Compressed...is invalid. – Jennifer Williams Nov 08 '13 at 22:54
If I download the zip file directly from CPanel File Manager, it unzips fine and the macro works with it. It only doesn't work when I use the download button from the CMS screen which uses the code above. Weird. Unfortunately, the website company that created our custom CMS is no longer around. – Jennifer Williams Nov 08 '13 at 22:57
2

So basically it is not the Excel VBA problem but the website problem which is not downloading the file correctly? – Siddharth Rout Nov 09 '13 at 04:54

VBA script to Unzip Files - It's Just Creating Empty Folders

1 Answers1

Linked