looping through subdirectories in a zip file vba

[fwjcld]

Hi
I'm trying to loop through all the files in a directory, including subdirectories and copy anything that has the word 'spec' in it to another location. It work fine until I come across a zip file, which has subdirectories in it. Does anyone know how I loop through files in a subdirectory of a zip file? I've searched on the internet but can't find anything that I can get to work.
Any help gratefully received!

Sub FindZipFileNames(sh, FName)
Dim fileNameInZip, iFileName As String, newFolder As String, nextDir As String, SubF

If FName.items.Count > 0 Then
For Each fileNameInZip In FName.items
If fileNameInZip.isfolder = True Then 'Or LCase(Right(fileNameInZip.Name, 3)) <> "zip" Then
' ' ????

Else
copyFile = False
iFileName = fileNameInZip.Name
If InStr(iFileName, ".") > 0 Then
If Mid(iFileName, Len(iFileName) - 2, 3) = "doc" Or Mid(iFileName, Len(iFileName) - 3, 4) = "docx" Or Mid(iFileName, Len(iFileName) - 3, 4) = "docm" Then
If InStr(UCase(nName), "SPEC") > 0 Then
copyFile = True
cntOther = cntOther + 1
End If
End If
If copyFile = True Then
newFolder = outFolder & Mid(FName, Len(inFolder) + 1, Len(FName) - Len(inFolder)) & ""
If bDirExists(newFolder) = False Then
cntlevels = Len(newFolder) - Len(Replace(newFolder, "", "")) - 1
iPos = InStr(newFolder, "")
For iLevel = 1 To cntlevels
iPos = InStr(iPos + 1, newFolder, "")
nextDir = Mid(newFolder, 1, iPos)
If bDirExists(nextDir) = False Then
MkDir nextDir
End If
Next iLevel
End If
oApp.Namespace(CStr(newFolder)).CopyHere oApp.Namespace(CStr(FName)).items.Item(CStr(fileNameInZip))
End If
End If
End If
Next
End If
Set oApp = Nothing

End Sub

 

[John_w]

Unzip the files to a (temporary) folder and search that. This shows how to unzip a .zip file:

Public Sub Unzip()

    Dim zipFile As Variant, destFolder As Variant
    Dim Sh As Object
    Dim CopyHereFlags As Variant
            
    CopyHereFlags = 4 + 8 + 16 'https://docs.microsoft.com/en-us/windows/desktop/shell/folder-copyhere
    
    zipFile = "C:\folder\path\files.zip"     '.zip file to be unzipped
    destFolder = "C:\path"                    'destination folder of .zip file's unzipped contents
    
    Set Sh = CreateObject("Shell.Application")
    With Sh        
        .Namespace(destFolder).CopyHere .Namespace(zipFile).Items, CopyHereFlags
    End With
    
End Sub

In addition, if you want to search subfolders of subfolders then you'll need to redesign your code so it can call itself (a recursive procedure).

 

[fwjcld]

Thanks for your help. I was coming to the conclusion that I would need to unzip everything but as I have lots of files to process I was hoping there might be a way to search the zip file first so I would only need to unzip the files I needed.

 

[fwjcld]

I have implemented this solution which seemed to be working fine but have just realised that it doesn't always unzip everything in the zipped file. Could this be something to do with the version in winzip that was used to zip it in the first place or because there are multiple levels of folders and subfolders within the zipped file? It doesn't work if I try and unzip the whole file manually either so I'm guessing there nothing much I can do about this using VBA?