Cinema
10-18-2016, 06:51 AM
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
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