This looks like a class project I had in college where the teacher gavbe us
bad input data to make sure we did all the proper error checking. The data
you provided has lot of different formats which makes reading very hard. You
have to do a lot of testing of the data to import the data correctly.
You need to change the file name in the code below to match your input file.
I can modify the code as required. If you tell me how to determine where
the breaks occur I can modify the code to put the data in more than one
worksheet.
Sub Gettext()
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
'default folder
Folder = "C:\temp\"
FName = "abc.txt"
Cells.NumberFormat = "General"
Set fsread = CreateObject("Scripting.FileSystemObject")
Set fread = fsread.GetFile(Folder & FName)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)
RowCount = 1
Do While tsread.atendofstream = False
InputLine = Trim(tsread.ReadLine)
ColCount = 1
If Len(InputLine) > 0 Then
'check for dots
If InStr(InputLine, ".") > 0 Then
Do While InStr(InputLine, ".") > 0
'check if there is a space as the 1st character
If Left(InputLine, 1) = " " Then
InputLine = Trim(InputLine)
Data = Left(InputLine, InStr(InputLine, " ") - 1)
Cells(RowCount, ColCount) = Data
InputLine = Trim(Mid(InputLine, InStr(InputLine, " ")))
Cells(RowCount, ColCount + 1) = InputLine
Exit Do
Else
Data = Left(InputLine, InStr(InputLine, ".") - 1)
Cells(RowCount, ColCount) = Data
InputLine = Mid(InputLine, InStr(InputLine, "."))
'remove leading dots
Do While Left(InputLine, 1) = "."
InputLine = Mid(InputLine, 2)
Loop
End If
ColCount = ColCount + 1
Loop
InputLine = Trim(InputLine)
If Len(InputLine) > 0 Then
If InputLine = "NOT USED" Then
Cells(RowCount, ColCount) = InputLine
Else
If InStr(InputLine, " ") > 0 Then
Data = Left(InputLine, InStr(InputLine, " ") - 1)
Cells(RowCount, ColCount) = Data
InputLine = Trim(Mid(InputLine, InStr(InputLine, " ") + 1))
ColCount = ColCount + 1
End If
End If
Cells(RowCount, ColCount) = Trim(InputLine)
End If
Else
If InStr(InputLine, " ") > 0 Then
Do While InStr(InputLine, " ") > 0
Data = Left(InputLine, InStr(InputLine, " ") - 1)
Cells(RowCount, ColCount) = Data
InputLine = Trim(Mid(InputLine, InStr(InputLine, " ")))
ColCount = ColCount + 1
Loop
End If
If Len(InputLine) > 0 Then
Cells(RowCount, ColCount) = InputLine
End If
End If
RowCount = RowCount + 1
End If
Loop
tsread.Close
End Sub