【OutlookVBA】メール本文から必要な情報を項目別に抽出する

仕事上、メール本文から必要な情報を項目別に書き出す必要がありました。
例によって、「OutlookVBA研究所」様に参考になる記事がありました。
outlooklab.wordpress.com

これを自分なりに読んで応用し、課題を解決できました。

こんな感じのメールに対して処理を行い、
=========================================================
購入日 ： 2021年06月12日
購入額 ： 980円
使用ポイント　 ： 0pt
合計　 ： 980円

支払方法 ： クレジットカード
=========================================================

結果的に、こんな感じのエクセルに

こんな感じに書き込めました。

以下のコードは、OutlookVBA研究所様の記事を私なりに解釈しなおして書き直したものです。
レベルは低いですが（レベルが低いからこそ）、参考になる方がいれば幸いです。

【前提】
再度記載すると、今回の処理対象は以下のようなメールです。

メールの本文
=========================================================
購入日 ： 2021年06月12日
購入額 ： 980円
使用ポイント　 ： 0pt
合計　 ： 980円

支払方法 ： クレジットカード
=========================================================
どう見てもFANZA購入時のメールです。本当にありがとうございました。

このメールから「購入日」「購入額」「使用ポイント」「合計」「支払方法」の情報を抜き出してエクセルに書き込みます。
以下のような処理を行います。
①対象のメールをメールオブジェクトとして扱えるようにする。
②メールオブジェクトから本文を変数にセット。
③Instr関数で本文の中の指定した単語までの文字数を取得
④mid関数で本文の中の指定した単語以降の文字列を取得
（購入日 ： 2021年～===）
⑤Instr関数で「指定した単語以降の文字列」の先頭から最初の改行までの文字数を取得
（「購入日」の「購」から「06月12日」の後ろにある見えない改行までの文字数を取得）
⑥Left関数で「指定した単語以降の文字列から最初の改行までの文字列」を取得
（購入日 ： 2021年06月12日）
⑦Instr関数で「指定した単語以降の文字列から最初の改行までの文字列」の中の「指定した単語から最初の空白までの文字数」を取得
（「購」から「：」の前の「　」までの文字数を取得）
⑧mid関数で「指定した単語以降の文字列から最初の改行までの文字列」の中の最初の空白以降の文字列を取得
（ ： 2021年06月12日）
⑨do～whileとifを組み合わせて、「指定した単語以降の文字列から最初の改行までの文字列の中の最初の空白以降の文字列」の中の最後の空白以降の文字列を取得（これがExcelに書き込む文字列になる）
（2021年06月12日）
⑩ExcelをGetobjectする。
⑪⑨で取得した文字列をExcelに書き込む

自分で書いてて頭がこんがらがりそうです。
コードは以下のとおりです。

sub sumple()

'処理①
 If TypeName(Application.ActiveWindow) = "Inspector" Then
 Set objItem = Application.ActiveInspector.CurrentItem
 Else
 Set objItem = ActiveExplorer.Selection(1)
 End If

'処理②
本文 = objItem.Body
'処理③
検索単語 = "購入日"
検索単語までの文字数 = InStr(本文, 検索単語)
'処理④　（購入日 ： 2021年～===）を取得
検索単語以降の文字列 = Mid(本文, 検索単語までの文字数)
'処理⑤　（「購入日」の「購」から「06月12日」の後ろにある見えない改行までの文字数を取得）
検索単語から改行までの文字数 = InStr(検索単語以降の文字列, vbCrLf)
'処理⑥　（購入日 ： 2021年06月12日）を取得
検索単語から改行までの文字列 = Left(検索単語以降の文字列, 検索単語から改行までの文字数)
'処理⑦　（「購」から「：」の前の「　」までの文字数）を取得
検索単語から空白までの文字数 = InStr(検索単語から改行までの文字列, " ")
'処理⑧　（ ： 2021年06月12日）を取得
検索単語から改行までの文字列の最初の空白以降の文字列 = Mid(検索単語から改行までの文字列, 検索単語から空白までの文字数)

'処理⑨　（2021年06月12日）を取得
i = 1
Do While _
Mid(検索単語から改行までの文字列の最初の空白以降の文字列, i, 1) = " " Or _
Mid(検索単語から改行までの文字列の最初の空白以降の文字列, i, 1) = "　" Or _
Mid(検索単語から改行までの文字列の最初の空白以降の文字列, i, 1) = "："
i = i + 1
Loop

''処理⑩
Set objExcel = GetObject(, "Excel.Application")

''処理⑪　書き込み
Excel記入事項 = Mid(検索単語から改行までの文字列の最初の空白以降の文字列, i)
ObjExcel.Workbooks("エクセルファイル.xlsx").ActiveSheet.Range("A2") = Excel記入事項

とりあえずこれで「購入日」が取得できて、Excelに書き込めます。
ほかの情報も同様にやれば取得できます。