Extract text files from zip files and import contents to Excel

[swaggerbox]

I need to extract text files from multiple zip files and import the contents (excluding non-blank and non-total rows) to Excel.

The code (found it at Ron de Bruin's site) below performs the action on a single zip file. How to modify this to apply to all zip files?

Sub Unzip2()
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String
    Dim fileNameInZip As Variant

    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=False)
    If Fname = False Then

    Else

        DefPath = Application.DefaultFilePath
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        strDate = Format(Now, " dd-mm-yy h-mm-ss")
        FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

        MkDir FileNameFolder

        'Extract the files into the newly created folder
        Set oApp = CreateObject("Shell.Application")

        For Each fileNameInZip In oApp.Namespace(Fname).items
            If LCase(fileNameInZip) Like LCase("*.txt") Then
                oApp.Namespace(FileNameFolder).CopyHere _
                        oApp.Namespace(Fname).items.Item(CStr(fileNameInZip))
            End If
        Next

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    End If
End Sub

Also, how to create a macro that will extract the contents of all the text files to Excel sheet (Sheet1) that does not include the blank rows and the rows that have totals on it.

Example content of the text file Textfile1.txt

AX5825400B1, 20151202, 20151202
AX5825500B1, 20151202, 20151202
AX5826331B1, 20151202, 20151202


Total - 3 files

This should be pasted in the Excel sheet as shown below:

Column A
AX5825400B1
AX5825500B1
AX5826331B1

Column B
20151202
20151202
20151202

Yes, it should ignore the last value.

Any ideas to get started?

[snb]

Yes, analyse the code thoroughly ( using F8 ), so you will be able to adapt it to your wishes.

[Charlize]

Possible way to solve this problem with multiple selections of zip files ...

Sub Unzip2()
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String
    Dim fileNameInZip As Variant
    Dim fileno
    'changed multiselect to true
    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
    MultiSelect:=True)
    'when error pops up when no selection is made, jump to errorhandler
    'and exit this procedure
    On Error GoTo ErrorStuff
    'loop through selected files
    For fileno = LBound(Fname) To UBound(Fname)
        MsgBox Fname(fileno)
    
        'DefPath = Application.DefaultFilePath
        'If Right(DefPath, 1) <> "\" Then
        '    DefPath = DefPath & "\"
        'End If
         
        'strDate = Format(Now, " dd-mm-yy h-mm-ss")
        'FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
        '
        'MkDir FileNameFolder
         
        'Extract the files into the newly created folder
        'Set oApp = CreateObject("Shell.Application")
         
        'added the counter to Fname -> Fname(fileno)
        
        'For Each fileNameInZip In oApp.Namespace(Fname(fileno)).items
        '    If LCase(fileNameInZip) Like LCase("*.txt") Then
        '        oApp.Namespace(FileNameFolder).CopyHere _
        '        oApp.Namespace(Fname(fileno)).items.Item(CStr(fileNameInZip))
        '    End If
        'Next
        '
        'Set FSO = CreateObject("scripting.filesystemobject")
        'FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    
    Next fileno
    
    Exit Sub
    
ErrorStuff:
    MsgBox "No zip file picked ...", vbInformation
    
End Sub

Charlize

[swaggerbox]

Thanks both