Unzip file or files with the default Windows zip program (VBA)
Information
Warning: The code below is not supported by Microsoft
It is not possible to hide the copy dialog when you copy from a zip folder (only working with normal folders).
Also there is no possibility to avoid that someone can cancel the CopyHere operation or that your VBA
code will be notified that the operation has been cancelled.
Note: Do not Dim for example FileNameFolder as String in the code examples.
This must be a Variant, if you change this the code will not work.
If you want to zip files see this page on my site.
http://www.rondebruin.nl/windowsxpzip.htm
See also the the Zip (compress) section on my site for examples for 7-zip and WinZip.
Example 1
With this example you can browse to the zip file.
After you select the zip file the macro will create a new folder in your DefaultFilePath
and unzip the Zip file in that folder. You can run the code without any changes.
Example 2
The macro below is almost the same as above. The only difference is that it will only
extract txt files from the Zip file. Change this "*.txt" to extract the files you want.
If you want to extract one file from a Zip file see the commented code in the macro above.
Example 3
The macros above will create a new folder for you to copy the files in
but this macro unzip the zip file in a fixed folder "C:\Users\Ron\test\"
See the commented code in the macro to delete the files in the folder first if you want.
Example 4
The macro below is almost the same as Example 1. The only difference is that you can
select more then one zip file to unzip in the same folder it create.
Warning: The code below is not supported by Microsoft
It is not possible to hide the copy dialog when you copy from a zip folder (only working with normal folders).
Also there is no possibility to avoid that someone can cancel the CopyHere operation or that your VBA
code will be notified that the operation has been cancelled.
Note: Do not Dim for example FileNameFolder as String in the code examples.
This must be a Variant, if you change this the code will not work.
If you want to zip files see this page on my site.
http://www.rondebruin.nl/windowsxpzip.htm
See also the the Zip (compress) section on my site for examples for 7-zip and WinZip.
Example 1
With this example you can browse to the zip file.
After you select the zip file the macro will create a new folder in your DefaultFilePath
and unzip the Zip file in that folder. You can run the code without any changes.
Sub Unzip1()
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)
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
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
Example 2
The macro below is almost the same as above. The only difference is that it will only
extract txt files from the Zip file. Change this "*.txt" to extract the files you want.
If you want to extract one file from a Zip file see the commented code in the macro above.
Sub Unzip2()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Dim fileNameInZip As Variant
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
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")
'Change this "*.txt" to extract the files you want
For Each fileNameInZip In oApp.Namespace(Fname).items
If LCase(fileNameInZip) Like LCase("*.txt") Then
oApp.Namespace(FileNameFolder).CopyHere _
oApp.Namespace(Fname).items.Item(CStr(fileNameInZip))
End If
Next
MsgBox "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
Example 3
The macros above will create a new folder for you to copy the files in
but this macro unzip the zip file in a fixed folder "C:\Users\Ron\test\"
See the commented code in the macro to delete the files in the folder first if you want.
Sub Unzip3()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
'Destination folder
DefPath = "C:\Users\Ron\test\" '<<< Change path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
FileNameFolder = DefPath
' 'Delete all the files in the folder DefPath first if you want
' On Error Resume Next
' Kill DefPath & "*.*"
' On Error GoTo 0
'Extract the files into the Destination folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
MsgBox "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
Example 4
The macro below is almost the same as Example 1. The only difference is that you can
select more then one zip file to unzip in the same folder it create.
Sub Unzip4()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Dim I As Long
Dim num As Long
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=True)
If IsArray(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")
For I = LBound(Fname) To UBound(Fname)
num = oApp.Namespace(FileNameFolder).items.Count
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname(I)).items
Next I
MsgBox "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