Options for parsing a text file to columns - excel

Question

I am looking for some input and possible example for parsing a text file with the following format: (sorry not sure how to retain the formatting of the file in this text)
NAME ID FORMAT SHORT NAME
DESCRIPTION (this field is on the second row an indented by 5 spaces)
The first row (NAME, ID, FORMAT and SHORT NAME) always consist of just one row. The DESCRIPTION text may span multiple rows. In some cases, there is only a first row of NAME, ID, etc. without a corresponding DESCRIPTION row.
Here is an example of how the data looks in the file now:
NAME ID FORMAT SHORT NAME
DESCRIPTION
ABC 01 xx AB
abcdefg
hijklm
nopqrs
DEF 02 xx DE
abcedfg
hijklmnopqrst
GHI 03 xx.x GH
JKL 001 xx JKL
abcdef
ghijk
lmnopq
rstu
vwxyz
I would like to parse out the NAME, ID, FORMAT, SHORT NAME and DESCRIPTION into 5 separate columns in a csv or excel file for additional analysis. I don't care if the DESCRIPTION field is broken across multiple lines but it can also be concatenated into a single longer string.
Hope this all makes sense. Thanks in advance!

Answer 1

Providing the data for NAME,ID,FORMAT and SHORT NAME is aligned
beneath their header word then use those words on the first line
to calculate the start position and length of each field, then split
the lines into fields using Mid(). Join the description lines and write out to
the previous record before a new record is started. For example
Option Explicit
Sub ParseTextFile()
Const INFILE = "c:\temp\testfile.txt"
Const OUTFILE = "c:\temp\testfile.xlsx"
Dim wbOut As Workbook, ws As Worksheet, iRow As Long
Dim txt As String, ff As Integer, i As Integer, desc As String
Dim start(4) As Integer, length(4) As Integer
Dim count As Integer, msg As String
Set wbOut = Workbooks.Add
Set ws = wbOut.Sheets("Sheet1")
ws.Range("A1:E1") = Array("NAME", "ID", "FORMAT", "SHORT NAME", "DESCRIPTION")
ws.Columns("A:E").NumberFormat = "#"
iRow = 1
ff = FreeFile()
Open INFILE For Input As #ff
While Not EOF(ff)
count = count + 1
Line Input #ff, txt
If count = 1 Then
start(1) = InStr(1, txt, "NAME", vbTextCompare)
start(2) = InStr(1, txt, "ID", vbTextCompare)
start(3) = InStr(1, txt, "FORMAT", vbTextCompare)
start(4) = InStr(1, txt, "SHORT NAME", vbTextCompare)
For i = 1 To 3
length(i) = start(i + 1) - start(i)
Next
Else
If Left(txt, 1) = " " Then
desc = desc & Trim(txt) & " "
Else
' save the description from last record
ws.Cells(iRow, 5) = Trim(desc)
desc = ""
' new row
iRow = iRow + 1
length(4) = Len(txt) - start(4) + 1
For i = 1 To 4
ws.Cells(iRow, i) = Mid(txt, start(i), length(i))
Next
End If
End If
Wend
Close #ff
' final description
ws.Cells(iRow, 5) = Trim(desc)
' save result
ws.Columns("A:E").AutoFit
wbOut.Close True, OUTFILE
msg = count & " lines read from " & INFILE & vbCr & _
iRow - 1 & " rows written to " & OUTFILE
MsgBox msg, vbInformation
End Sub