Extract all filenames including files within subfolder from multiple zip files

[gdesreu]

Hi,

I have a directory of ~2000 zip files. I would like to use VBA to search through each zip file and extract all filenames including the ones listed in sub-folders within the zip files and then list them in excel. Does anyone have VBA for this? Ive seen some examples that work but they do not search sub-folders so that doesnt work for my needs. I need to know the filenames of every single file within the zip files regardless of sub-folders.

Thanks

 

[AlphaFrog]

Change the root folder in the code to suit.

Sub FileDirectory()
    
    Dim strRootFolder As String
    Dim strFile As String
    
    strRootFolder = "C:\Test\"  'Change Path to suit
    strFile = "*.zip"
    
    Application.ScreenUpdating = False
    
    ListAllFiles strRootFolder, strFile
    
    Application.ScreenUpdating = True
    
End Sub


Function ListAllFiles(ByVal strPath As String, Optional ByVal strFile As String)
                  
    Dim fsoSubfolder As Object
    Dim fsoFile As Object
    Dim strRootFolder As String
    Dim strFiles As String
    
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    If strFile = "" Then strFile = "*"
    
    With CreateObject("Scripting.FileSystemObject").GetFolder(strPath)
        For Each fsoFile In .Files
            If fsoFile.Name Like strFile Then
                With Range("A" & Rows.Count).End(xlUp)
                    .Offset(1).Value = fsoFile.Name
                    .Offset(1, 1).Value = Left(fsoFile.Path, Len(fsoFile.Path) - Len(fsoFile.Name)) 'Optional: List path
                End With
            End If
        Next fsoFile
        
        'Search subfolders
        For Each fsoSubfolder In .SubFolders
            ListAllFiles fsoSubfolder.Path, strFile
        Next fsoSubfolder
    End With
    
End Function

 

[gdesreu]

Change the root folder in the code to suit.

Sub FileDirectory()
   
    Dim strRootFolder As String
    Dim strFile As String
   
    strRootFolder = "C:\Test\"  'Change Path to suit
    strFile = "*.zip"
   
    Application.ScreenUpdating = False
   
    ListAllFiles strRootFolder, strFile
   
    Application.ScreenUpdating = True
   
End Sub


Function ListAllFiles(ByVal strPath As String, Optional ByVal strFile As String)
                 
    Dim fsoSubfolder As Object
    Dim fsoFile As Object
    Dim strRootFolder As String
    Dim strFiles As String
   
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    If strFile = "" Then strFile = "*"
   
    With CreateObject("Scripting.FileSystemObject").GetFolder(strPath)
        For Each fsoFile In .Files
            If fsoFile.Name Like strFile Then
                With Range("A" & Rows.Count).End(xlUp)
                    .Offset(1).Value = fsoFile.Name
                    .Offset(1, 1).Value = Left(fsoFile.Path, Len(fsoFile.Path) - Len(fsoFile.Name)) 'Optional: List path
                End With
            End If
        Next fsoFile
       
        'Search subfolders
        For Each fsoSubfolder In .SubFolders
            ListAllFiles fsoSubfolder.Path, strFile
        Next fsoSubfolder
    End With
   
End Function

Thanks AlphaFrog, this is very useful code, however, I was looking to search for the filenames within each of the zip files and return all files names within the ZIP file including files that are in all subfolders. I essentially have 2000+ zip files that I need to know the contents of at the filename level. This code gives me the zip file names in the folder which is also extremely useful to me so thanks for that. If its not possible to read all the files (including files in subfolders) in a zip without unzipping then that is also useful to know. I really dont want to unzip these unless you experts tell me I have to so I figured I would ask first before heading down that road. - Thanks again

 

[AlphaFrog]

I was looking to search for the filenames within each of the zip files and return all files names within the ZIP file including files that are in all subfolders.

Sorry for the misunderstanding. I do not know if that is possible or not.

 

[HighAndWilder]

Sorry for the misunderstanding. I do not know if that is possible or not.

Hi,

I have a directory of ~2000 zip files. I would like to use VBA to search through each zip file and extract all filenames including the ones listed in sub-folders within the zip files and then list them in excel. Does anyone have VBA for this? Ive seen some examples that work but they do not search sub-folders so that doesnt work for my needs. I need to know the filenames of every single file within the zip files regardless of sub-folders.

Thanks

This came up on OzGrid in 2010.

List Contents of zip file including folders / subfolders using VBA? - OzGrid Free Excel/VBA Help Forum

 

[gdesreu]

This came up on OzGrid in 2010.

List Contents of zip file including folders / subfolders using VBA? - OzGrid Free Excel/VBA Help Forum

Thanks, I saw this. It didnt work for me. It looks like its 32bit. I tried the ptrsafe but it still failed

 

[Fuji]

See if this works,

Sub test()
    Dim myDir$, fn$, n&, myList$()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    [a:b].ClearContents
    fn = Dir(myDir & "*.zip", vbDirectory)
    Do While fn <> ""
        n = n + 1
        ReDim Preserve myList(1 To 2, 1 To n)
        myList(1, n) = fn
        GetFiles CreateObject("Shell.Application").Namespace(CVar(myDir & fn)), n, myList
        fn = Dir
    Loop
    If n Then [a1].Resize(n, 2) = Application.Transpose(myList)
    [a:b].Columns.AutoFit
End Sub

Private Sub GetFiles(myFolder As Object, n, myList)
    Dim myFile As Object
    For Each myFile In myFolder.items
        If Not myFile.IsFolder Then
            n = n + 1
            ReDim Preserve myList(1 To 2, 1 To n)
            myList(2, n) = myFile.Name
        End If
    Next
    For Each myFile In myFolder.items
        If myFile.IsFolder Then
            n = n + 1
            ReDim Preserve myList(1 To 2, 1 To n)
            myList(1, n) = myFile.Name
            GetFiles CreateObject("Shell.Application").Namespace( _
            CVar(myFolder.Self.Path & "\" & myFile.Name)), n, myList
        End If
    Next
End Sub

 

[gdesreu]

See if this works,

Sub test()
    Dim myDir$, fn$, n&, myList$()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    [a:b].ClearContents
    fn = Dir(myDir & "*.zip", vbDirectory)
    Do While fn <> ""
        n = n + 1
        ReDim Preserve myList(1 To 2, 1 To n)
        myList(1, n) = fn
        GetFiles CreateObject("Shell.Application").Namespace(CVar(myDir & fn)), n, myList
        fn = Dir
    Loop
    If n Then [a1].Resize(n, 2) = Application.Transpose(myList)
    [a:b].Columns.AutoFit
End Sub

Private Sub GetFiles(myFolder As Object, n, myList)
    Dim myFile As Object
    For Each myFile In myFolder.items
        If Not myFile.IsFolder Then
            n = n + 1
            ReDim Preserve myList(1 To 2, 1 To n)
            myList(2, n) = myFile.Name
        End If
    Next
    For Each myFile In myFolder.items
        If myFile.IsFolder Then
            n = n + 1
            ReDim Preserve myList(1 To 2, 1 To n)
            myList(1, n) = myFile.Name
            GetFiles CreateObject("Shell.Application").Namespace( _
            CVar(myFolder.Self.Path & "\" & myFile.Name)), n, myList
        End If
    Next
End Sub

Thanks Fuji but it appears to have just given me only the zip file names sporadically through the worksheet with a lot of #n/a's as well.

 

[Fuji]

So, you are on 64bit.

I don't have 64 ver, so this is not tested.

1) You need to set the reference to "Microsoft Shell Controls And Automation"

2)

Sub test()
    Dim myDir$, fn$, n&, myList$()
    Dim myShell As New Shell
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    [a:b].ClearContents
    fn = Dir(myDir & "*.zip", vbDirectory)
    Do While fn <> ""
        n = n + 1
        ReDim Preserve myList(1 To 2, 1 To n)
        myList(1, n) = fn
        GetFiles myShell.Namespace(CVar(myDir & fn)), n, myList
        fn = Dir
    Loop
    If n Then [a1].Resize(n, 2) = Application.Transpose(myList)
    [a:b].Columns.AutoFit
End Sub

Private Sub GetFiles(myFolder As Object, n, myList)
    Dim myFile As ShellFolderItem, myShell As New Shell
    For Each myFile In myFolder.items
        If Not myFile.IsFolder Then
            n = n + 1
            ReDim Preserve myList(1 To 2, 1 To n)
            myList(2, n) = myFile.Name
        End If
    Next
    For Each myFile In myFolder.items
        If myFile.IsFolder Then
            n = n + 1
            ReDim Preserve myList(1 To 2, 1 To n)
            myList(1, n) = myFile.Name
            GetFiles myShell.Namespace(CVar(myFolder.Self.Path & "\" & myFile.Name)), n, myList
        End If
    Next
End Sub