| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| How to merge Excel address columns when some zips begin with zeros | Excel Discussion (Misc queries) | |||
| zip/unzip excel files | Excel Discussion (Misc queries) | |||
| Unzip fuction in excel | Excel Worksheet Functions | |||
| Purging ZIPCODES from a string of cities and zips | Excel Worksheet Functions | |||
| Want to Unzip files automatically | Excel Programming | |||
Linear Mode
