VBA provides some file operation statements that can be used to read from or write to a text file. Most text files are easily imported into Excel using File > Open and the Text Import Wizard. Sometimes the file contains so much junk to clean up that it’s easier to write your own procedure.
In this example, I have a carat (^) delimited text file with some extraneous tabs and linefeeds.
I want to read this file in one line at a time, strip out the characters I don’t want, then write the remaining text to cells.
Dim sFile As String
Dim sInput As String
Dim lFNum As Long
Dim vaFields As Variant
Dim i As Long
Dim lRow As Long
Dim vaStrip As Variant
Const sDELIM = “^” ‘Set the delimeter
lFNum = FreeFile
sFile = “C:CaratDelim.txt”
vaStrip = Array(vbLf, vbTab) ‘list the text to strip
‘Open the file
Open sFile For Input As lFNum
‘Loop through the file until the end
Do While Not EOF(lFNum)
Line Input #lFNum, sInput ‘input the current line
‘remove the unwanted text
For i = LBound(vaStrip) To UBound(vaStrip)
sInput = Replace(sInput, vaStrip(i), “”)
Next i
‘split the text based on the delimeter
vaFields = Split(sInput, sDELIM)
lRow = lRow + 1
‘Write to the worksheet
For i = 0 To UBound(vaFields)
Sheet1.Cells(lRow, i + 1).Value = vaFields(i)
Next i
Loop
Close lFNum
End Sub
The result is a clean table in Excel.
Of course, if the real life file was as simple as this example, you would just import it normally and do some finding and replacing. But the bigger the file and the more complex the text you need to remove, the more attractive a technique like this becomes.
Here’s an MSDN article that discusses the alternatives before pushing an ADO solution:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnclinic/html/scripting03092004.asp
It;s very much in the Dick K stylee e.g. it has a subheading, ‘I Dozed Off; What Did You Say Header Rows Were?’
Jamie.
I was having a lot of trouble dealing with text files too big (more than 65K records) to directly import into Excel (didn’t need all the reocrds).
This was a really handy piece of VBA that was easily adapted to my use and will save many hours of work.
I’ve just added the line:
If Left(sInput, 1) = “M”
which identifies my record type and now can read what I need in. I’ll be able to further adapt this going forward.
You save a lot of my work. Your clean step through code works fine and easy to trace.
Thanks for the sharing.
Another text file importer is here:
http://newtonexcelbach.wordpress.com/2008/05/19/importing-text-files-with-vba/
The main difference is it:
Reads the whole text file into a string.
Splits the string into an array.
(Does stuff on the array)
Writes the array to a spreadsheet range with a single operation.
For big files it will be much quicker. Importing a 5MB, 128,000 line file (using XL2007) is almost instantaneous.
Hi,
I tried to run this code and runtime error 53 (file not found) was returned. How do I get around this?
Thanks,
W
Will – do you mean my code in the preceding comment, or Dick’s code in the original post?
An Alternative, using Word’s built-in facilities:
On Error Resume Next
‘ open Word if it’s not in the memory already
GetObject , “Word.Application”
If Err.Number > 0 Then CreateObject “Word.application”
With GetObject(, “Word.Application”)
.Documents.Add “E:OFadressen.txt”
‘ replace the current fielddelimiter (vbtab) by the comma
With .Selection.Find
.Execute vbTab, , , , , , , 1, , “,”, 2
‘ delete undesired characters
For j = 1 To 5
.Execute Choose(j, “a”, “b”, “c”, “d”, “e”), , , , , , , 1, , “”, 2
Next
End With
‘ save the txt file as csv file
With .ActiveDocument
.SaveAs “E:OFadressen 000.csv”, 2
.Close
End With
End With
‘ opene the csv file as a new workbook
Workbooks.Add “E:OFadressen 000.csv”
End Sub
the a, b, c are representing characters that you want to be deleted from your file. Because of the limitations of WordPress (or my unability tot overcome them) I used thes chacters instead of the escape -characters I should avoid.
I suspect that my method runs faster than Dick’s suggestion.
Hi all, basic macro was good, I changed it a bit as I needed to add filtering to the data I wanted to import.
There is hard coding (sincerest apologies, was in a hurry) & I’ve specified row 15 as the row to look for the filter criteria but you can change it as necessary.
USAGE: Specify the filter in the excel column that relates to the csv data you want to filter, i.e. if you want csv column 3 to be GBP then enter “=GBP” in column c in excel. You need “” around the filters or excel will think it’s a formula & I’ve made the criteria case sensitive on purpose.
NOT: If specifying a date as a filter, regional date settings must match the format of the csv date or some of the dates won’t match.
Example filters:”=123456?, “abcdef”, “xyzxyz”, “like *abcd*”
Enjoy. :)
Tig (aka TheIrishGit)
Option Explicit
Sub Import()
Const lngLastRow As Long = 60000
Const strDelimiter As String = “,”
Const strYMD As String = “yyyymmdd”
Dim objDestWkBk As Workbook
Dim objDestWkSht As Worksheet
Dim bFilter, bSkip As Boolean
Dim varCriteria() As Variant
Dim varResult As Variant
Dim varStartTime As Variant
Dim varEndTime As Variant
Dim dblCounter As Double
Dim lngFNumber As Long
Dim lngCounter As Long
Dim lngRows As Long
Dim i As Long
Dim strResult As String
Dim strFName As String
Dim strCriteria As String
On Error GoTo CleanUp
Application.ScreenUpdating = False
‘Find any filter criteria
If WorksheetFunction.CountA(Cells) > 0 Then
lngCounter = Cells.Find(What:=”*”, After:=[A1], SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
ReDim varCriteria(lngCounter)
‘Check for a filter on ROW 15, removing surrounding double quotes
For i = 1 To lngCounter
varCriteria(i) = Cells(15, i).Text
If varCriteria(i) > “” Then
bFilter = True
varCriteria(i) = Replace(varCriteria(i), Chr(34), “”)
End If
Next i
‘Initialize variables
strFName = CStr(Application.GetOpenFilename)
If strFName = “” Or strFName = “False” Then End
lngFNumber = FreeFile()
dblCounter = 1
lngCounter = 1
‘Open File
Open strFName For Input As #lngFNumber
varStartTime = Time
‘Create new workbook
Set objDestWkBk = Workbooks.Add(template:=xlWorksheet)
Set objDestWkSht = objDestWkBk.Worksheets(1)
‘Import the File
Do While Seek(lngFNumber) “” Then
If LCase(Mid(varCriteria(i), 1, 4)) = “like” Then
If Not varResult(i – 1) Like Mid(varCriteria(i), 6) Then bSkip = True
ElseIf Mid(varCriteria(i), 1, 2) = “” Then
If varResult(i – 1) = Mid(varCriteria(i), 3) Then bSkip = True
ElseIf Mid(varCriteria(i), 1, 2) = ” _
Format(Mid(varCriteria(i), 3), strYMD) Then bSkip = True
Else
If varResult(i – 1) > Mid(varCriteria(i), 3) Then bSkip = True
End If
ElseIf Mid(varCriteria(i), 1, 2) = “>=” Then
If IsDate(varResult(i – 1)) Then
If Format(varResult(i – 1), strYMD) Mid(varCriteria(i), 2) Then bSkip = True
ElseIf Mid(varCriteria(i), 1, 1) = “>” Then
If IsDate(varResult(i – 1)) Then
If Format(varResult(i – 1), strYMD) = _
Format(Mid(varCriteria(i), 2), strYMD) Then bSkip = True
Else
If varResult(i – 1) >= Mid(varCriteria(i), 2) Then bSkip = True
End If
End If
End If
Next i
End If
‘Output data & increment counters unless skipping this row
If Not bSkip Then
For i = LBound(varResult) To UBound(varResult)
objDestWkSht.Cells(lngCounter, i + 1).Value = varResult(i)
Next i
If lngCounter = lngLastRow Then
lngCounter = 1
With objDestWkBk
Set objDestWkSht = .Worksheets.Add
objDestWkSht.Move After:=.Sheets(.Sheets.Count)
End With
Else: lngCounter = lngCounter + 1
End If
lngRows = lngRows + 1
End If
dblCounter = dblCounter + 1
Loop
CleanUp:
Close
Application.StatusBar = False
Application.ScreenUpdating = True
If Err.Number
Um, the code above didn’t paste in correctly for some reason, here it is again.
Option Explicit
Sub Import()
Const lngLastRow As Long = 60000
Const strDelimiter As String = “,”
Const strYMD As String = “yyyymmdd”
Dim objDestWkBk As Workbook
Dim objDestWkSht As Worksheet
Dim bFilter, bSkip As Boolean
Dim varCriteria() As Variant
Dim varResult As Variant
Dim varStartTime As Variant
Dim varEndTime As Variant
Dim dblCounter As Double
Dim lngFNumber As Long
Dim lngCounter As Long
Dim lngRows As Long
Dim i As Long
Dim strResult As String
Dim strFName As String
Dim strCriteria As String
On Error GoTo CleanUp
Application.ScreenUpdating = False
‘Find any filter criteria
If WorksheetFunction.CountA(Cells) > 0 Then
lngCounter = Cells.Find(What:=”*”, After:=[A1], SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
ReDim varCriteria(lngCounter)
‘Check for a filter on ROW 15, removing surrounding double quotes
For i = 1 To lngCounter
varCriteria(i) = Cells(15, i).Text
If varCriteria(i) > “” Then
bFilter = True
varCriteria(i) = Replace(varCriteria(i), Chr(34), “”)
End If
Next i
‘Initialize variables
strFName = CStr(Application.GetOpenFilename)
If strFName = “” Or strFName = “False” Then End
lngFNumber = FreeFile()
dblCounter = 1
lngCounter = 1
‘Open File
Open strFName For Input As #lngFNumber
varStartTime = Time
‘Create new workbook
Set objDestWkBk = Workbooks.Add(template:=xlWorksheet)
Set objDestWkSht = objDestWkBk.Worksheets(1)
‘Import the File
Do While Seek(lngFNumber) “” Then
If LCase(Mid(varCriteria(i), 1, 4)) = “like” Then
If Not varResult(i – 1) Like Mid(varCriteria(i), 6) Then bSkip = True
ElseIf Mid(varCriteria(i), 1, 2) = “” Then
If varResult(i – 1) = Mid(varCriteria(i), 3) Then bSkip = True
ElseIf Mid(varCriteria(i), 1, 2) = ” _
Format(Mid(varCriteria(i), 3), strYMD) Then bSkip = True
Else
If varResult(i – 1) > Mid(varCriteria(i), 3) Then bSkip = True
End If
ElseIf Mid(varCriteria(i), 1, 2) = “>=” Then
If IsDate(varResult(i – 1)) Then
If Format(varResult(i – 1), strYMD) Mid(varCriteria(i), 2) Then bSkip = True
ElseIf Mid(varCriteria(i), 1, 1) = “>” Then
If IsDate(varResult(i – 1)) Then
If Format(varResult(i – 1), strYMD) = _
Format(Mid(varCriteria(i), 2), strYMD) Then bSkip = True
Else
If varResult(i – 1) >= Mid(varCriteria(i), 2) Then bSkip = True
End If
End If
End If
Next i
End If
‘Output data & increment counters unless skipping this row
If Not bSkip Then
For i = LBound(varResult) To UBound(varResult)
objDestWkSht.Cells(lngCounter, i + 1).Value = varResult(i)
Next i
If lngCounter = lngLastRow Then
lngCounter = 1
With objDestWkBk
Set objDestWkSht = .Worksheets.Add
objDestWkSht.Move After:=.Sheets(.Sheets.Count)
End With
Else: lngCounter = lngCounter + 1
End If
lngRows = lngRows + 1
End If
dblCounter = dblCounter + 1
Loop
CleanUp:
Close
Application.StatusBar = False
Application.ScreenUpdating = True
If Err.Number
Ok, 3rd time lucky with VB tags.
Option Explicit
Sub Import()
Const lngLastRow As Long = 60000
Const strDelimiter As String = ","
Const strYMD As String = "yyyymmdd"
Dim objDestWkBk As Workbook
Dim objDestWkSht As Worksheet
Dim bFilter, bSkip As Boolean
Dim varCriteria() As Variant
Dim varResult As Variant
Dim varStartTime As Variant
Dim varEndTime As Variant
Dim dblCounter As Double
Dim lngFNumber As Long
Dim lngCounter As Long
Dim lngRows As Long
Dim i As Long
Dim strResult As String
Dim strFName As String
Dim strCriteria As String
On Error GoTo CleanUp
Application.ScreenUpdating = False
'Find any filter criteria
If WorksheetFunction.CountA(Cells) > 0 Then
lngCounter = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
ReDim varCriteria(lngCounter)
'Check for a filter on ROW 15, removing surrounding double quotes
For i = 1 To lngCounter
varCriteria(i) = Cells(15, i).Text
If varCriteria(i) > "" Then
bFilter = True
varCriteria(i) = Replace(varCriteria(i), Chr(34), "")
End If
Next i
'Initialize variables
strFName = CStr(Application.GetOpenFilename)
If strFName = "" Or strFName = "False" Then End
lngFNumber = FreeFile()
dblCounter = 1
lngCounter = 1
'Open File
Open strFName For Input As #lngFNumber
varStartTime = Time
'Create new workbook
Set objDestWkBk = Workbooks.Add(template:=xlWorksheet)
Set objDestWkSht = objDestWkBk.Worksheets(1)
'Import the File
Do While Seek(lngFNumber) "" Then
If LCase(Mid(varCriteria(i), 1, 4)) = "like" Then
If Not varResult(i - 1) Like Mid(varCriteria(i), 6) Then bSkip = True
ElseIf Mid(varCriteria(i), 1, 2) = "" Then
If varResult(i - 1) = Mid(varCriteria(i), 3) Then bSkip = True
ElseIf Mid(varCriteria(i), 1, 2) = " _
Format(Mid(varCriteria(i), 3), strYMD) Then bSkip = True
Else
If varResult(i - 1) > Mid(varCriteria(i), 3) Then bSkip = True
End If
ElseIf Mid(varCriteria(i), 1, 2) = ">=" Then
If IsDate(varResult(i - 1)) Then
If Format(varResult(i - 1), strYMD) Mid(varCriteria(i), 2) Then bSkip = True
ElseIf Mid(varCriteria(i), 1, 1) = ">" Then
If IsDate(varResult(i - 1)) Then
If Format(varResult(i - 1), strYMD) = _
Format(Mid(varCriteria(i), 2), strYMD) Then bSkip = True
Else
If varResult(i - 1) >= Mid(varCriteria(i), 2) Then bSkip = True
End If
End If
End If
Next i
End If
'Output data & increment counters unless skipping this row
If Not bSkip Then
For i = LBound(varResult) To UBound(varResult)
objDestWkSht.Cells(lngCounter, i + 1).Value = varResult(i)
Next i
If lngCounter = lngLastRow Then
lngCounter = 1
With objDestWkBk
Set objDestWkSht = .Worksheets.Add
objDestWkSht.Move After:=.Sheets(.Sheets.Count)
End With
Else: lngCounter = lngCounter + 1
End If
lngRows = lngRows + 1
End If
dblCounter = dblCounter + 1
Loop
CleanUp:
Close
Application.StatusBar = False
Application.ScreenUpdating = True
If Err.Number
Sorry guys, given up trying to paste the code.
Tig :(
TheIrishGit: You have to escape your greater-than characters to post code in the comments. Or you can mail it to me and I’ll post it for you.
Mine failed , I can’t figure what why? Function Replace was not defined and does not look like in-built. Could anyone assist me?
Emeka
Hi all,
Do you know how can I select data in one line with information in another line in text file?
for example:
in text file:
*****************************************************
line 1: 1234 – data
Line 2: all data are needed
*****************************************************
I want copy some words in line2 to excel, but I can’t use any word from that line as guide.
in this case can I use (1234) in line1 as a guide to select data in line2?