How to extract zip files by looping through folders

[Cinema]

Hi,

I want to unzip zip files that are in the same Folder but in different subfolders. The path of the Folder is in Cell(1,1) and the names of the subfolders are listed in Range("B1:B" & LastRow). Next to the Names of the subfolders are the file names of the zip files. For example B1 has the entry \SubfolderTest\ and C1 has the entry test.zip

Now my aim is to unzip all zip files by Looping through the subfolders and then extract them all in the Mainfolder where the subfolders are.

I have found a code to extract zip files. I tried to adjust it but failed :(

Here is the code from the Internet:


Sub TestRun()

'Change this as per your requirement
Call UnZip("C:\Users\NC\Desktop\Vishesh\Test", "C:\Users\NC\Desktop\Vishesh\Test\TestZipFile.Zip")

End Sub



Sub UnZip(strTargetPath As String, Fname As Variant)

Dim oApp As Object

Dim FileNameFolder As Variant



If Right(strTargetPath, 1) <> Application.PathSeparator Then

strTargetPath = strTargetPath & Application.PathSeparator

End If



FileNameFolder = strTargetPath



Set oApp = CreateObject("Shell.Application")

oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

End Sub






Here is my try:


Sub TestRun()

Dim tool As Workbook
Dim ws As Worksheet
Dim fpath As String
Dim fname As Range


fpath = tool.ws.Cells(1, 1).Value
Set tool = ThisWorkbook
For Each fname In Range("B1:B" & LastRow)
Call UnZip(fpath, Cel)
Next Cel
End Sub



Sub UnZip(fpath As String, fname As Variant)

Dim oApp As Object

Dim FileNameFolder As Variant



If Right(strTargetPath, 1) <> Application.PathSeparator Then

strTargetPath = strTargetPath & Application.PathSeparator

End If



FileNameFolder = strTargetPath



Set oApp = CreateObject("Shell.Application")

oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).items

End Sub

[onlyadrafter]

Hello,

does this get you any closer (can't really check without the actual files etc,) Have broken the code out a bit so you can make changes as required.


Dim MY_DESTINATION As String
Dim MY_LOCATION As String
Sub TestRun()
MY_DESTINATION = Range("A1").Value
For MY_ROWS = 1 To Range("B" & Rows.Count).End(xlUp).Row
MY_LOCATION = MY_DESTINATION & Range("B" & MY_ROWS).Value
MY_FILE = MY_DESTINATION & Range("B" & MY_ROWS).Value & Range("C" & MY_ROWS).Value
Call UnZip(MY_LOCATION, MY_FILE)
Next MY_ROWS
End Sub
Sub UnZip(strTargetPath As String, Fname As Variant)
Dim oApp As Object
Dim FileNameFolder As Variant
If Right(strTargetPath, 1) <> Application.PathSeparator Then
strTargetPath = strTargetPath & Application.PathSeparator
End If
FileNameFolder = strTargetPath
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
End Sub

[Trebor76]

For reference this has been cross-posted here (http://www.mrexcel.com/forum/excel-questions/971134-how-extract-zip-files-looping-through-folders.html)

[Cinema]

Hi onlyadrafter,

thank you very much. But I have a Problem with the line

oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items


I have an error of 91.

[onlyadrafter]

Hello,

I think it depends exactly how you have your data entered.

In A1 i have C:

in B1 I have \testzip\

in C1 I have test.zip.

I created a folder in C:\ called testzip, i put a zipped filed called test in C:\ then ran this code:


Dim MY_DESTINATION As StringDim MY_LOCATION As String
Sub TestRun()
MY_DESTINATION = Range("A1").Value
For MY_ROWS = 1 To Range("B" & Rows.Count).End(xlUp).Row
MY_LOCATION = MY_DESTINATION & Range("B" & MY_ROWS).Value
MY_FILE = MY_DESTINATION & "\" & Range("C" & MY_ROWS).Value
Call UnZip(MY_LOCATION, MY_FILE)
Next MY_ROWS
End Sub
Sub UnZip(strTargetPath As String, Fname As Variant)
Dim oApp As Object
Dim FileNameFolder As Variant
If Right(strTargetPath, 1) <> Application.PathSeparator Then
strTargetPath = strTargetPath & Application.PathSeparator
End If
FileNameFolder = strTargetPath
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
End Sub

it then unzipped test.zip into c:\testztip folder.

[Dave]

This might be useful... http://www.vbaexpress.com/forum/showthread.php?17357-Using-Namespace-and-Objects&highlight= Dave