Unzip files using excel macro.

[abhay_547]

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.

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.

 

[abhay_547]

Hi All,

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

Thanks a lot for your help in advance.

 

[manmeet]

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

 

[arpankarmakar]

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

 

[mshaik224]

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.