Unzip - multiple zips
 

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

Unzip - multiple zips
 

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

Unzip - multiple zips
 

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

Unzip - multiple zips
 

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

Unzip - multiple zips
 

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

Unzip - multiple zips
 

Hi John

Is it possible that you send me 3 or three zip files private
Easier to test then for me

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


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

Unzip - multiple zips
 

2 or 3 <g

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


"Ron de Bruin" wrote in message ...
Hi John

Is it possible that you send me 3 or three zip files private
Easier to test then for me

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


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

Unzip - multiple zips
 

On its way

John

"Ron de Bruin" wrote:

Hi John

Is it possible that you send me 3 or three zip files private
Easier to test then for me

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


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

Unzip - multiple zips
 

Nothing in my mailbox ?

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


"JohnUK" wrote in message ...
On its way

John

"Ron de Bruin" wrote:

Hi John

Is it possible that you send me 3 or three zip files private
Easier to test then for me

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


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

Unzip - multiple zips
 

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

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


"Ron de Bruin" wrote in message ...
Nothing in my mailbox ?

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


"JohnUK" wrote in message ...
On its way

John

"Ron de Bruin" wrote:

Hi John

Is it possible that you send me 3 or three zip files private
Easier to test then for me

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


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

Unzip - multiple zips
 

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




"Ron de Bruin" wrote:

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

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


"Ron de Bruin" wrote in message ...
Nothing in my mailbox ?

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


"JohnUK" wrote in message ...
On its way

John

"Ron de Bruin" wrote:

Hi John

Is it possible that you send me 3 or three zip files private
Easier to test then for me

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


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

Unzip - multiple zips
 

No Problem John

I add the example to my site
http://www.rondebruin.nl/windowsxpzip.htm

Maybe useful for others

Good night


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


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




"Ron de Bruin" wrote:

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

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


"Ron de Bruin" wrote in message ...
Nothing in my mailbox ?

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


"JohnUK" wrote in message ...
On its way

John

"Ron de Bruin" wrote:

Hi John

Is it possible that you send me 3 or three zip files private
Easier to test then for me

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


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