Unzip files using excel macro.

abhay_547

Board Regular
Joined
Sep 12, 2009
Messages
179
Hi All,

I have the below macro which loops through all files in a directory and then unzips the zip files. I have another macro to download some file from different urls actually a userform which has listbox with all links listed in it and the names of the files to be named post download from those links. I want to identify the zip files and post download unzip and rename them as per the name reflecting in the lisbox and save in the same directory. Actually all those files contain the excel files which I want to rename as per the names reflecting in listbox.

Code:
Sub RUNZIPPER()

'Run before you leave and keep excel running in the background
Application.OnTime TimeValue("19:00:00"), "UnZipMe"


End Sub

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\Graeme\Documents\Alex TEST\"

'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 FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String

    'Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=False)
    Fname = str_FILENAME
                                        
                                        
    If Fname = False Then
        'Do nothing
    Else
        'Root folder for the new folder.
        'You can also use DefPath = "C:\Users\Ron\test\"
        DefPath = Application.DefaultFilePath
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        'Create the folder name
        strDate = Format(Now, " dd-mm-yy h-mm-ss")
        FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

        'Make the normal folder in DefPath
        MkDir FileNameFolder

        'Extract the files into the newly created folder
        Set oApp = CreateObject("Shell.Application")

        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

        'If you want to extract only one file you can use this:
        'oApp.Namespace(FileNameFolder).CopyHere _
         'oApp.Namespace(Fname).items.Item("test.txt")

        'MsgBox "You find the files here: " & FileNameFolder
        Debug.Print "You find the files here: " & FileNameFolder

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    End If
End Sub

Please find my macro file on this link : http://www.4shared.com/document/_S41_s4P/Download_Tool_ver_4_2_.html

Thanks a lot for your help in advance.:)
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Hi All,

Did anyone get the chance to look into the above post. ?

Thanks a lot for your help in advance.
smile.gif
 
Upvote 0
Dear Abhay,
Your code is working perfect.But i have to modify for my requirement.But i face one problem.Need your help to solve this.I modify it for two folders each contain zip file and that contain file name data_report.csv file i want to extract file in each folder.Code is as below and error i got run time error 91 (Object variable or With block variable not set)
Where i got this error mentioned with bold letters

Please help me out thanks in advance

Sub UnZipMe()
Dim str_FILENAME As String, str_DIRECTORY As String, str_DESTINATION As String
Dim i As Integer
Dim j As String
'Your directory where zip file is kept
For i = 0 To 1
If i = 0 Then
j = "0"
ElseIf i = 1 Then
j = "1"
End If
str_DIRECTORY = "C:\Users\Graeme\Documents\Alex TEST" & j & "\"
MsgBox (str_DIRECTORY)
'Loop through all zip files in a given directory
str_FILENAME = Dir(str_DIRECTORY & "*.zip")
MsgBox (str_FILENAME)
Do While Len(str_FILENAME) > 0
Call Unzip1(str_FILENAME, str_DIRECTORY, i, j)
Debug.Print str_FILENAME
str_FILENAME = Dir

Loop
Next i
End Sub
Sub Unzip1(str_FILENAME As String, str_DIRECTORY As String, i As Integer, j As String)
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String

'Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
Fname = str_FILENAME
MsgBox (Fname)

If Fname = False Then
'Do nothing
Else
'Root folder for the new folder.
'You can also use DefPath = "C:\Users\Ron\test\" OR Application.DefaultFilePath
DefPath = "C:\Users\Graeme\Documents\Alex TEST" & j & "\"
MsgBox (DefPath)
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"


'Make the normal folder in DefPath
MkDir FileNameFolder
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")

' oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
'If you want to extract only one file you can use this:
oApp.Namespace(FileNameFolder).CopyHere _
oApp.Namespace(Fname).items.Item("data_report.csv")

'MsgBox "You find the files here: " & FileNameFolder
Debug.Print "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
 
Upvote 0
I have some 10 zip files and each zip file contains one .csv file. I want to rename the .csv file after unzip. Please help. Thanks.

Dear Abhay,
Your code is working perfect.But i have to modify for my requirement.But i face one problem.Need your help to solve this.I modify it for two folders each contain zip file and that contain file name data_report.csv file i want to extract file in each folder.Code is as below and error i got run time error 91 (Object variable or With block variable not set)
Where i got this error mentioned with bold letters

Please help me out thanks in advance

Sub UnZipMe()
Dim str_FILENAME As String, str_DIRECTORY As String, str_DESTINATION As String
Dim i As Integer
Dim j As String
'Your directory where zip file is kept
For i = 0 To 1
If i = 0 Then
j = "0"
ElseIf i = 1 Then
j = "1"
End If
str_DIRECTORY = "C:\Users\Graeme\Documents\Alex TEST" & j & "\"
MsgBox (str_DIRECTORY)
'Loop through all zip files in a given directory
str_FILENAME = Dir(str_DIRECTORY & "*.zip")
MsgBox (str_FILENAME)
Do While Len(str_FILENAME) > 0
Call Unzip1(str_FILENAME, str_DIRECTORY, i, j)
Debug.Print str_FILENAME
str_FILENAME = Dir

Loop
Next i
End Sub
Sub Unzip1(str_FILENAME As String, str_DIRECTORY As String, i As Integer, j As String)
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String

'Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
Fname = str_FILENAME
MsgBox (Fname)

If Fname = False Then
'Do nothing
Else
'Root folder for the new folder.
'You can also use DefPath = "C:\Users\Ron\test\" OR Application.DefaultFilePath
DefPath = "C:\Users\Graeme\Documents\Alex TEST" & j & "\"
MsgBox (DefPath)
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"


'Make the normal folder in DefPath
MkDir FileNameFolder
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")

' oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
'If you want to extract only one file you can use this:
oApp.Namespace(FileNameFolder).CopyHere _
oApp.Namespace(Fname).items.Item("data_report.csv")

'MsgBox "You find the files here: " & FileNameFolder
Debug.Print "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
 
Upvote 0
Hi,

I have many zip files in a folder and I need only excel files from the zip files and save them in a folder. Can you help me.

Thanks alot in advance.
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,312
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top