Outlookのメールをアーカイブするために、テキストファイルで保存したい

#メールファイルを「アーカイブ」したい
Gsuiteの利用もかなり浸透していますが、Microsoftのエコシステムを利用していてOutlookメールを外部とのコミュニケーションツールとして利用している会社も多いと思います。

そういった場合に相手とのやり取りとのエビデンスとしてメール内容をローカルにバックアップしたい需要はたまにあるのですが、Outlook画面からメールをデスクトップにドラッグするとOutlookアイテム（msgファイル）となってしまい、メタ情報を含んだままデータをアーカイブすることになります。
このままでは人に引き継ぐときや渡すときにメタ情報を含むためセキュリティ的な観点や、ファイルの扱いやすさからもちょっと気持ち悪いです。そこでmsgファイルをテキストファイルに変換するスクリプトを作成しました。

#コード
下のコードをメモ帳かなにかテキストエディタに貼り付けて「.vbs」で保存してください。

msg2txt.vbs

Dim fileTemp, txtMail, fileCurrent, objOutlook, msgTmp, fileTxt,msgRe,petternRe

Set txtMail = CreateObject("Scripting.FileSystemObject")
Set fileCurrent = txtMail.GetFolder(".")
Set objOutlook = CreateObject("Outlook.Application")

For Each  fileTemp In fileCurrent.Files
If LCase(txtMail.GetExtensionName(fileTemp.Name)) = "msg" Then
Set msgTmp = objOutlook.CreateItemFromTemplate(fileCurrent & "\" & fileTemp.Name)

'Outlook書式付きの改行削除
set petternRe = createObject("VBScript.RegExp")
petternRe.Global= True
petternRe.pattern = "\s" & vbcrlf 
msgRe = petternRe.Replace( msgTmp.body, "" )

Set fileTxt = txtMail.OpenTextFile(fileCurrent & "\" & txtMail.GetBaseName(fileTemp.Name) & ".txt", 2, True, -1)
fileTxt.WriteLine("送信者》 " & msgTmp.SenderName)
fileTxt.WriteLine("受信者》 " & msgTmp.To)
fileTxt.WriteLine("CC》 " & msgTmp.CC)
fileTxt.WriteLine("BCC》 " & msgTmp.Bcc)
fileTxt.WriteLine("件名》 " & msgTmp.Subject)
fileTxt.WriteLine("本文》 " &msgRe)
fileTxt.Close
Set fileTxt = Nothing
Set msgTmp = Nothing
End If
Next
Set petternRe = Nothing
Set fileTxt = Nothing
Set msgTmp = Nothing
MsgBox("書き出しました。")

#使い方
後はこのスクリプトファイルと、変換したいOutlookのメッセージファイルを同じフォルダに保存して、スクリプトファイルをダブルクリックしてください。同一ディレクトリにテキストファイルが生成されます。

良いメールライフを。