Excel VBA - 麻烦将 WhatsApp 聊天记录文件导入 Excel sheet

Question

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

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

此外，第 3 条消息（待购列表）由多行组成，在 WhatsApp 聊天中是通过按回车键实现的。

我的目标是将上面的数据导入到 Excel sheet 中，这样四条消息中的每条消息都各自成行，如下所示：

到目前为止，我一直在尝试使用 Workbook.OpenText 方法，但惨遭失败。问题是多行的待购列表最终以单独的行结尾，而不是被视为整条消息。

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

编辑： 请在下方找到我目前正在使用的导入 .txt 文件的代码。我并不是要求一个优雅的解决方案，对不起，如果它是这样出来的。我只是说我希望它最终变得优雅，只需要一两个线索，或者更多。

Sub ImportTXT ()

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

If ChatFileNm = False Then Exit Sub

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

好的，既然 OpenText 方法不适合你，让我们从类似这样的东西开始，它使用内置的 I/O 方法 (Open and Line Input) 来读取文件，它应该比 FileSystemObject 更快，并且由于您处理的是原始 text/data，您将比仅使用 Workbooks.OpenText.

具有更大的灵活性

如果您的文本文件被损坏（就像您提供的屏幕截图中那样），我们可能需要添加一些条件逻辑来确定每个 "line" 何时开始，但首先，让我们看看这是如何工作的。

它将开始在 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

Excel VBA - 麻烦将 WhatsApp 聊天记录文件导入 Excel sheet

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

import

excel

vba

chat

whatsapp