Excel Macro: List All Files From zip File

This Excel macro can list all files from zip file. Click here if you need to list all files in a folder and subfolders.

List All Files From zip File

'-------------- Modules --------------
'----------- ExcelBaby.com -----------
Sub ListFilesFromZip()
    Dim PathFilename As Variant
    PathFilename = Application.GetOpenFilename("ZipFile (*.zip), *.zip")
    If PathFilename = "False" Then Exit Sub

    Application.ScreenUpdating = False 'Disable Screen Updating to speed up macro
    
    'Add a worksheet with name "Files"
    Dim Mysheet As Worksheet, F As Boolean
    For Each Mysheet In ThisWorkbook.Worksheets
        If Mysheet.Name = "Files" Then
            F = True
            Exit For
        Else
            F = False
        End If
    Next
    If Not F Then Sheets.Add.Name = "Files"
    
    'Add table header
    With Sheets("Files")
        .Cells.Delete
        .Cells(1, 1) = "Path"
        .Cells(1, 2) = "Folder"
        .Cells(1, 3) = "File Name"
        .Cells(1, 4) = "File Type"
        .Cells(1, 5) = "Last Modified"
        .Cells(1, 6) = "Size"
    End With
    
    Dim objShell As Object
    Dim objFolder As Object
    'Late Binding: Microsoft Shell Controls And Automation
    Set objShell = CreateObject("shell.application")
    Set objFolder = objShell.Namespace(PathFilename)
    ReExec objShell, objFolder
    
    Application.ScreenUpdating = True
End Sub

Sub ReExec(objShell, objFolder)
    Dim i, subFolder
    Dim LastBlankCell

    For Each i In objFolder.items
        If i.isfolder Then
            Set subFolder = objShell.Namespace(i)
            ReExec objShell, subFolder  'loop
        Else
            LastBlankCell = Sheets("Files").Cells(Rows.Count, 1).End(xlUp).Row + 1 'get the last blank cell of column A
            With Sheets("Files")
                .Cells(LastBlankCell, 1) = i.Path 'Path
                .Cells(LastBlankCell, 2) = i.Parent 'Parent Folder
                .Cells(LastBlankCell, 3) = i.Name 'File Name
                .Cells(LastBlankCell, 4) = i.Type 'File Type
                .Cells(LastBlankCell, 5) = i.ModifyDate 'Last Modified
                .Cells(LastBlankCell, 6) = i.Size 'File Size
            End With
            LastBlankCell = LastBlankCell + 1
        End If
    Next
End Sub

If you don't need to list subfoloders, replace ReExec procedure with the following code:

Sub ReExec(objShell, objFolder)
    Dim i, subFolder
    Dim LastBlankCell

    For Each i In objFolder.items
'        If i.isfolder Then
'            Set subFolder = objShell.Namespace(i)
'            ReExec objShell, subFolder  'loop
'        Else
            LastBlankCell = Sheets("Files").Cells(Rows.Count, 1).End(xlUp).Row + 1 'get the last blank cell of column A
            With Sheets("Files")
                .Cells(LastBlankCell, 1) = i.Path 'Path
                .Cells(LastBlankCell, 2) = i.Parent 'Parent Folder
                .Cells(LastBlankCell, 3) = i.Name 'File Name
                .Cells(LastBlankCell, 4) = i.Type 'File Type
                .Cells(LastBlankCell, 5) = i.ModifyDate 'Last Modified
                .Cells(LastBlankCell, 6) = i.Size 'File Size
            End With
            LastBlankCell = LastBlankCell + 1
'        End If
    Next
End Sub

If you want to check if the specified file exists in the zip file, E.g.: Price List.xlsx , replace ReExec procedure with the following code:

Sub ReExec(objShell, objFolder)
    Dim i, subFolder

    For Each i In objFolder.items
        If i.isfolder Then
            Set subFolder = objShell.Namespace(i)
            ReExec objShell, subFolder  'loop
        Else
            If i.Name = "Price List.xlsx" Then  'Search Price List.xlsx
                MsgBox "File exists in: " & i.Path
            End If
        End If
    Next
End Sub

Download

Download List All Files From zip File.

How to Use This Macro