Excel VBA - Troube WhatsAppチャット履歴ファイルをExcelシートにインポートする

Question

メモ帳で開いた場合の典型的なWhatsApp履歴チャットファイル（.txt）は次のようになります。実施例4つのメッセージ、各日付/タイムスタンプ&名で始まるがあること

注意。 また、すべてのメッセージの終わりを示す文字があります（Chr（10）と思われます）。

さらに、3番目のメッセージ（購入リスト）は複数の行で構成され、WhatsAppチャットではEnterキーを押すことで達成されます。

私の目標は、4つのメッセージのそれぞれが、独自の行で終わるように以下のように、Excelシートに上記のデータをインポートすることです：

これまでのところ、私はしましたWorkbook.OpenTextメソッドを使用して悲惨に失敗しようとしていました。問題は、購入リストの複数の行が、メッセージ全体として扱われるのではなく、別々の行になることです。

何千ものメッセージで膨大なチャットファイルを処理する必要があるため、すばやく洗練されたソリューションも必要です。 もちろん、私は、日付/時刻/ユーザー名のスタンプを持っているかどうかに基づいて行をループしてマージすることができますが、それは大きなファイルで時間がかかります。

EDIT：ここでは、.txtファイルをインポートするために私が現在使用しているコードを見てください。私はを要求していませんでした優雅な解決策、それがそんなことで出てきたらごめんなさい。私はちょうど私がそれがエレガントであることを最終的に愛することを意味しました、ちょうど手がかりまたは2つ以上を必要とします。

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

OK、OpenTextメソッドは、のファイルを読み取るため、内蔵I/O方法（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 

、ファイルからテキスト文字列全体を構築し、あなたの区切り文字としてChr(10)でSplit機能を使用します。

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