PDA

View Full Version : Extract text files from zip files and import contents to Excel



swaggerbox
12-03-2015, 02:59 AM
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
12-03-2015, 04:26 AM
Yes, analyse the code thoroughly ( using F8 ), so you will be able to adapt it to your wishes.

Charlize
12-03-2015, 06:10 AM
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
12-06-2015, 05:33 AM
Thanks both