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?
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?