Hi Ron,
It does one file and then gets stuck in the loop. The files a

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

and so on, if that helps

John
"Ron de Bruin" wrote:

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 he " & FileNameFolder
Set oApp = Nothing
End If
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"JohnUK" wrote in message ...
Wow - that was quick. Thanks for your help Ron.
That would be ideal
John

"Ron de Bruin" wrote:

Hi John

Do you want all zip files you select unzipped in the same folder ?


--
Regards Ron de Bruin
http://www.rondebruin.nl


"JohnUK" wrote in message ...
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 he " & 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