Excel VBA - 将 WhatsApp 聊天历史记录文件导入 Excel 工作表时遇到问题

Question

这是在记事本中打开典型的 WhatsApp 历史记录聊天文件 (.txt) 的样子。

请注意，示例中有 4 条消息，每条消息均以日期/时间戳和用户名开头。 此外，还有一些字符标记每条消息的结尾（对我来说似乎是 Chr(10)）。

更重要的是，第三条消息（待购买列表）由多行组成，这在 WhatsApp 聊天中是通过按 Enter 键来实现的。

我的目标是将上面的数据导入到 Excel 工作表中，以便四条消息中的每一条最终都在自己的一行中，如下所示：

到目前为止，我一直在尝试使用 Workbook.OpenText 方法，但都惨遭失败。问题在于，购买列表的多行最终会出现在单独的行中，而不是被视为整个消息。

我也需要一个快速而优雅的解决方案，因为我需要处理包含数千条消息的巨大聊天文件。 因此，当然，我可以根据行是否具有日期/时间/用户名标记来循环和合并行，但这在大文件上需要花费大量时间。

编辑： 请在下面找到我目前用于导入 .txt 文件的代码。我并不是“要求”一个优雅的解决方案，如果结果是这样的话，我很抱歉。我只是说我希望它最终变得优雅，只需要一两条或更多线索。

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

Answer 1

Open

和 Line Input）来读取文件，它应该比FileSystemObject并且由于您正在处理原始文本/数据，因此您将比仅使用

Workbooks.OpenText

拥有更大的灵活性。如果您的文本文件被破坏（就像您提供的屏幕截图中所示），我们可能需要添加一些条件逻辑来识别每个“行”何时开始，但首先，让我们看看它是如何工作的。

它将开始在 A 列、第 1 行写入每一行，然后按顺序写入每个连续行的第 2+ 行。

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

或者，从文件构建整个文本字符串，并使用 

Split

函数并以

Chr(10)

作为分隔符：

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

Answer 2