Unzip - multiple zips

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,
I have this brilliant piece of code that I picked up from Ron de Bruin web
site, that unzips a file and saves as unzipped.
Sub Unzip()
Dim oApp As Object
Dim fname
Dim FileNameFolder
Dim DefPath As String
fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip),
*.zip", _
MultiSelect:=True)
' I changed the MultiSelect:=False to True hoping it would work
If fname = False Then
Else
sPath = Application.DefaultFilePath & "\Schedules\Unzipped"
DefPath = sPath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
FileNameFolder = DefPath
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).items
MsgBox "Files can be found here: " & FileNameFolder
Set oApp = Nothing
End If
End Sub
(Slightly changed for my setup) The problem I have is, it only unzips one
file at a time. Is there some way that the code can do a loop of sorts so
that it would pick up all the zipped files within a folder in one go and
unzip?
Again - help much appreciated
Regards
John
 
Ok test this one for me John

Sub Unzip1_test()
Dim oApp As Object
Dim fname
Dim FileNameFolder
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
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

'Create normal folder
MkDir FileNameFolder

Set oApp = CreateObject("Shell.Application")

For I = LBound(fname) To UBound(fname)
num = oApp.NameSpace(FileNameFolder).items.Count

'Copy the files in the newly created folder
oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(fname(I)).items

On Error Resume Next
Do Until oApp.NameSpace(FileNameFolder).items.Count = num + oApp.NameSpace(fname(I)).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0

Next I

MsgBox "You find the files here: " & FileNameFolder
Set oApp = Nothing
End If
End Sub
 
Hi Ron,
It does one file and then gets stuck in the loop. The files are:

Generic Schedule Region 61 -306
Generic Schedule Region 62 -306
Generic Schedule Region 63 -306

and so on, if that helps

John
 
Hi John

Is it possible that you send me 3 or three zip files private
Easier to test then for me
 
My test is OK when I duplicate your zip files a few times and select
the zip files with my macro.

Maybe others can test the code also with a few zip files
 
Hi Ron,
It worked perfectly.

I am so stupid - I changed the names of the zipped files and not the files
themselves hence the code only opened one file.
Many thanks for your help Ron
All the best
John
 
Back
Top