Retrieve file names from a zip file

[JARichard74]

I have a zip file that has a varying number of folders and in each folder there is a text file (.txt). What I would like to do is extract the names of those text files and place them in the second column of a Table called Table1. I can find code to extract names from a file folder but not from a zip file. Any assistance would be appreciated. Thanks

 

[JARichard74]

Found an old post from Rick Rothstein to extract the folder names from the zip file. Would now need the code to extract the txt files from each folder. Thanks

Sub ListZipDetails()
  Dim R As Long, PathFilename As Variant, FileNameInZip As Variant, oApp As Object
  PathFilename = Application.GetOpenFilename("ZipFiles (*.zip), *.zip")
  If PathFilename = "False" Then Exit Sub
  R = Cells(Rows.Count, "A").End(xlUp).Row
  Set oApp = CreateObject("Shell.Application")
  For Each FileNameInZip In oApp.Namespace(PathFilename).Items
    R = R + 1
    Cells(R, "A").Value = FileNameInZip
  Next
  Set oApp = Nothing
End Sub

 

[JARichard74]

Found an old post from Rick Rothstein to extract the folder names from the zip file. Would now need the code to extract the txt files from each folder. Thanks

Sub ListZipDetails()
  Dim R As Long, PathFilename As Variant, FileNameInZip As Variant, oApp As Object
  PathFilename = Application.GetOpenFilename("ZipFiles (*.zip), *.zip")
  If PathFilename = "False" Then Exit Sub
  R = Cells(Rows.Count, "A").End(xlUp).Row
  Set oApp = CreateObject("Shell.Application")
  For Each FileNameInZip In oApp.Namespace(PathFilename).Items
    R = R + 1
    Cells(R, "A").Value = FileNameInZip
  Next
  Set oApp = Nothing
End Sub

The following code works well if there is no sub-folder in the zip i.e. File.zip - Folder 1 - Sub-folder 1. When there is a sub-folder I get error 76 Path not found on line Set xFolder = xFSO.GetFolder(FolderNameInZip)

Sub ListZipDetails()
  Dim R As Long, PathFilename As Variant, FolderNameInZip As Variant, oApp As Object
  Dim i As Integer
  Dim xFSO As Object, xFolder As Object, xFile As Object, Filename As Object
  PathFilename = Application.GetOpenFilename("ZipFiles (*.zip), *.zip")
  If PathFilename = "False" Then Exit Sub
  R = Cells(Rows.Count, "A").End(xlUp).Row
  Set oApp = CreateObject("Shell.Application")
  For Each FolderNameInZip In oApp.Namespace(PathFilename).Items
        Set xFSO = CreateObject("Scripting.FileSystemObject")
        Set xFolder = xFSO.GetFolder(FolderNameInZip)
        For Each xFile In xFolder.Files
        i = i + 1
        Cells(i, "A").Value = Replace(xFile.Name, ".txt", "")
        Next
  Next
  Set oApp = Nothing
End Sub