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

12,829

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
Share:
12,829
Jennifer Williams
Author by

Jennifer Williams

I am not a sophisticated programmer but know enough to be dangerous. I am an Excel master though.

Updated on June 14, 2022

Comments

  • Jennifer Williams
    Jennifer Williams almost 2 years

    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
    
  • Jennifer Williams
    Jennifer Williams over 10 years
    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: <a href="' . $photoLink . '">Download Photos</a> 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
    Jennifer Williams over 10 years
    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.
  • Siddharth Rout
    Siddharth Rout over 10 years
    So basically it is not the Excel VBA problem but the website problem which is not downloading the file correctly?