Excel VBA - Trouble importing WhatsApp chat history files into an Excel sheet

Here is what a typical WhatsApp history chat file (.txt) looks like if opened in Notepad.

Note that there are 4 messages in the example, each starting with a date/time stamp & username. Also, there're characters present that mark the end of every message (and seem to be Chr(10) to me).

What's more, the 3rd message (the to-buy list) consists of multiple lines, which in WhatsApp chat is achieved by hitting the Enter key.

My goal is to import the data above into an Excel sheet so as each of the four messages ends up in a row of its own, like below:

So far, I've been trying and failing miserably using the Workbook.OpenText method. The problem is that the multiple lines of the to-buy list end up in separate rows rather than being treated as a whole message.

I need a quick and elegant solution, too, as I'll need to process huge chat files with thousands of messages. So, of course, I could loop through and merge lines based on whether they have date/time/username stamps, but that takes a whole lot of time on a big file.

EDIT: Please, find below the code that I'm using at the moment to import the .txt files. I was not demanding an elegant solution, sorry if it came out like that. I just meant I would love for it to be elegant eventually, just need a clue or two, or more.

Sub ImportTXT ()

ChatFileNm = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), >*.txt", Title:="Select Chat File To Be Opened")

If ChatFileNm = False Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
SourceSheet = FSO.GetBaseName(ChatFileNm)

Workbooks.OpenText filename:= _
        ChatFileNm, _
        Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlTextQualifierNone, ConsecutiveDelimiter:=False, _ 
        Tab:=False,Semicolon:=False, _
        Comma:=False, Space:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1)), DecimalSeparator:=".", ThousandsSeparator:=",", _
        TrailingMinusNumbers:=True

End Sub

OK, so since the OpenText method isn't working for you, let's start with something like this which uses the built-in I/O methods (Open and Line Input) for reading files, it should be faster than FileSystemObject and since you're dealing with the raw text/data, you will have more flexibility than just using the Workbooks.OpenText.

If your text file is mangled (as it seems to be in the screenshots you've provided) we may need to add some conditional logic to identify when each "line" starts, but to get started, let's see how this works.

It will begin writing each line in Column A, at Row 1 and then sequentially to rows 2+ for each successive line.

Option Explicit
Sub f()
Dim ChatFileNm
Dim FF As Long
Dim destination As Range
Dim ctr As Long
Dim ln$

ChatFileNm = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), >*.txt", Title:="Select Chat File To Be Opened")
If ChatFileNm = False Then Exit Sub
Set destination = Range("A1")
FF = FreeFile
Open ChatFileNm For Input As FF
Do Until EOF(FF)
    Line Input #FF, ln
    'Write the line in to the destination
    destination.Offset(ctr).Value = ln
    'Increment the counter
    ctr = ctr + 1
Loop
'Release the lock on the file
Close FF

End Sub

Alternatively, build the entire text string from the file, and use the Split function with Chr(10) as your delimiter:

Option Explicit
Sub f()
Dim ChatFileNm
Dim FF As Long
Dim destination As Range
Dim ln$, txt$

ChatFileNm = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), >*.txt", Title:="Select Chat File To Be Opened")
If ChatFileNm = False Then Exit Sub
Set destination = Range("A1")
FF = FreeFile
Open ChatFileNm For Input As FF
Do Until EOF(FF)
    Line Input #FF, ln
    'Write the line in to the destination
    txt = txt & ln
Loop
'Release the lock on the file
Close FF

'Write to the sheet:
Dim lines
lines = Split(txt, Chr(10))
Range("A1").Resize(Ubound(lines)+1).Value = Application.Transpose(lines)

End Sub