'=================================================
'- MACRO TO IMPORT COMMA DELIMITED TEXT
'- copes with line breaks in the data
'- and files larger than 65536 lines
'- Brian Baulsom August 2005
'=================================================
Sub IMPORT_COMMA_DELIMITED()
Dim ExpectedNumberOfColumns As Integer
Dim FileName As String
Dim FileNum As Integer
Dim ToRow As Long
Dim ToCol As Integer
Dim ws As Worksheet
Dim TextLine As String
Dim MyDelimiter As String
Dim MyField As String
Dim LineLength As Integer
Dim c As String
Dim n
'==================================
'- CHANGE AS REQUIRED *********
ExpectedNumberOfColumns = 7
FileName = "C:\TEST\TEST.txt"
'==================================
'- initialise
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set ws = ActiveSheet
ws.Cells.ClearContents
ToRow = 1
MyDelimiter = "," ' comma
'-------------------------------------
'- MAIN LOOP
FileNum = FreeFile()
Open FileName For Input As #FileNum
ToCol = 1
MyField = ""
'==================================================
'- import textfile line by line
'==================================================
Do While Seek(FileNum) <= LOF(FileNum)
Application.StatusBar = _
"Importing Row : " & ToRow
'-----------------------------------------------
'- parse line
Line Input #FileNum, TextLine
LineLength = Len(TextLine)
For n = 1 To LineLength
c = Mid(TextLine, n, 1)
If c = MyDelimiter Then
ws.Cells(ToRow, ToCol).Value = MyField
ToCol = ToCol + 1
MyField = ""
Else
MyField = MyField & c
ws.Cells(ToRow, ToCol).Value = MyField
End If
Next
'============================================
'- if expected number of columns then
'- check row number for end of worksheet
'============================================
If ToCol = ExpectedNumberOfColumns Then
If ToRow = 65536 Then
Set ws = ActiveWorkbook.Sheets.Add ' add a sheet
ToRow = 2
Else
ToRow = ToRow + 1
End If
'---------------------------------------
ToCol = 1
MyField = ""
End If
Loop
'- finish ----------------------------------
Close #FileNum
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
MsgBox ("Imported " & ToRow - 1 & " lines.")
End Sub