【ExcelVBA】Outlookからメールデータを取得してシートに展開する（本文展開）

前回、Excelマクロ（VBA）でOutlookからメールデータを取得してシートに展開する方法について書きました。今回はメール本文の中を取得して定型文から必要情報を抽出したいと思います。

非IT企業に勤める中年サラリーマンのIT日記

【ExcelVBA】Outlookからメールデータを取得してシートに展開する

質問来ていたのでそれに答えようと思います。質問内容をざっとまとめるとこんな感じです。 Outlookの特定のフォルダにメールが保存されている マクロでフォルダを指定して、そのフォルダ内の全てのメールにアクセス。 メール本文から情報（メールアドレス、氏名、など）を抽出してExcelに転記 マクロはOutlook側・Excel側どちらでも構わない。今回はExcelマクロからOutlookの特定フォルダにアクセスしてメールをゲットしたいと思います。上記の依頼のうち本文解析はプログラムを複雑にしてしまうので次の機会にします。ま...

こちらがOutlookの様子ですが、「未決」フォルダ内にメールが保存されていて、それぞれ名前や年齢などが定型文で書かれています。

こちらがソースコードです。

Sub getOutlookMail()

   Set myapp = CreateObject("Outlook.Application")
   Set i_Folder = myapp.Session.GetDefaultFolder(6)
   Set myFolder = myapp.Session.Folders("xxxxx@outlook.jp").Folders("未決")

   Range("A2:G1000").ClearContents
   
   r = 2
   For idx = myFolder.Items.Count To 1 Step -1
      Cells(r, 1).Value = myFolder.Items(idx).Subject
      Cells(r, 2).Value = myFolder.Items(idx).SenderName
      Cells(r, 3).Value = myFolder.Items(idx).SenderEmailAddress
      Cells(r, 4).Value = myFolder.Items(idx).ReceivedTime
      Cells(r, 5).Value = getInfo(myFolder.Items(idx).body, "【名前】")
      Cells(r, 6).Value = getInfo(myFolder.Items(idx).body, "【年齢】")
      Cells(r, 7).Value = getInfo(myFolder.Items(idx).body, "【住所】")
      r = r + 1
   Next
End Sub

Function getInfo(mailbody As String, keyword As String) As String
   Dim textline As Variant
   textline = Split(mailbody, vbCrLf)
   
   getInfo = ""
   For i = 0 To UBound(textline)
      If InStr(textline(i), keyword) > 0 Then
         getInfo = Replace(textline(i), keyword, "")
         Exit Function
      End If
   Next
End Function
 

実行結果は以下の動画の通りです。

 - Excel, Outlook, VBA