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