CODEWITHSUNDEEP
vbaexcelzipunzip
Jennifer Williams
Jennifer Williams

Reputation: 65

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

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

Upvotes: 2

Views: 13146

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149277

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

Upvotes: 1

Related Questions