【VBA】ワークシート（セル）に受信メール一覧を作成する

こんにちは、Ryoです。
VBAはExcelのみならずメールソフト（Outlook)との連携も行うことが出来ます。今回はそのメールの「送信者」「タイトル」「受信日時」「本文」を取得し指定セルに書込む方法について「ダイアログ表示⇒メールソフト対象フォルダ選択」「受信トレイ以外のフォルダ指定」「受信トレイ内サブフォルダ指定」「送信者指定」等のサンプルを書いていきます。

1.サンプル概要
2.Sample1:ダイアログ表示⇒対象フォルダ選択
3.Sample2:受信トレイ以外のフォルダを指定する場合
4.Sample3:受信トレイ内のサブフォルダを指定する場合
5.Sample4:特定の送信者のみ取得する
6.まとめ

1.サンプル概要

Outlookの下書きに3通サンプルとして保存してありますので、これをセルに書込んでいきます。

これから以下に書いていくSample1の「ダイアログ表示⇒対象フォルダ選択」では、このようにダイアログボックスが表示されますので、「下書き」を選択して「OK」を押すと各項目に沿ってセルへ書き込まれます。

「送信者」が空欄になっていますが、これは「下書き」をサンプルとして使用した為なので、受信しているメールを選択すれば問題なく書き込まれますからご安心を。

2.Sample1:ダイアログ表示⇒対象フォルダ選択

ここから書いていくサンプルコードはExcel/Outlook共に2016環境で動作確認しています。

VBAでメールを取得するには「MAPI」を指定して使用するのですが、これは「Messeging Application Programming Interface」の略で、Microsoftがメールなどの送受信アプリケーションのために作ったものです。

詳細などはこちらにMAPIリファレンスがあるので、ご興味ある方はご参照ください。ここではVBAでメール取得するにはMAPI指定することが必要とご理解いただければ良いと思います。

そのMAPIを使用したサンプルコードはこちらになります。

'ダイアログ表示してフォルダを指定する場合
Sub Sample1()

 Dim objOutlook, objNamespace, objFolder As Object
 Dim i As Long
 
 'Outlookオブジェクトの生成
 Set objOutlook = CreateObject(&quot;Outlook.Application&quot;)
 '名前空間を取得
 Set objNamespace = objOutlook.GetNamespace(&quot;MAPI&quot;)
 '対象フォルダ選択用のダイアログボックスを表示する
 Set objFolder = objNamespace.PickFolder
 
 '対象フォルダ内全てのアイテムに対し処理を行う
 For i = 1 To objFolder.Items.Count
   'メールアイテムであれば処理実行
   If objFolder.Items(i).Class = 43 Then
       '「送信者名」をセルA列に書込み
       Cells(i + 1, 1).Value = objFolder.Items(i).SenderName
       '「メールタイトル」をセルB列に書込み
       Cells(i + 1, 2).Value = objFolder.Items(i).Subject
       '「受信日時」をセルC列に書込み
       Cells(i + 1, 3).Value = objFolder.Items(i).ReceivedTime
       '「本文」をセルD列に書込み
       Cells(i + 1, 4).Value = objFolder.Items(i).Body
    End If
  Next
  
  'セットした変数を解除
  Set objOutlook = Nothing
  Set objNamespace = Nothing

End Sub

実行するとサンプル概要で示した動作の通りになります。

上に書いたMAPIですが、サンプルコード内にある以下の記述がメールを取得する際は必ず書くことになる部分ですね。

Set objOutlook = CreateObject(“Outlook.Application”)
Set objNamespace = objOutlook.GetNamespace(“MAPI”)

ここでOutlookを起動（オブジェクト生成）して、GetNamespaceにて指定した名前空間を取得します。後はPickFolderメソッドを使用することで、ダイアログボックスを表示する流れです。（因みに私の環境ではOutlook起動していなくても普通に動作出来ます）

そこで選択したフォルダはobjFolderにセットされ、フォルダ内全アイテム(objFolder.Items.Count)に対し処理を実行します。

処理の中でIf objFolder.Items(i).Class = 43はメールアイテムの判別ですが、この「43」はこちらにある通り、定数となっています。

後は「送信者名」「メールタイトル」「受信日時」「本文」をそれぞれ指定セルに転記し、セットした変数を解除して終了です。

3.Sample2:受信トレイ以外のフォルダを指定する場合

このサンプルは何かと言いますと、ダイアログボックスを表示させて選択するのは煩わしいので、直接指定したいけど受信トレイ以外のフォルダ（例えば「下書き」など）から取得するにはどうすれば？という観点で書いたものです。

何ともないことのようですが、実は受信トレイ以外のフォルダを指定する場合は一手間必要なのです。

'受信トレイ以外のフォルダを指定する場合
Sub Sample2()

 '受信トレイの定数
 Const olFolderInbox = 6
 Dim objOutlook, objNamespace, objFolder As Object
 Dim objInbox, strFolderName, objMailbox As Object
 Dim i As Long
 
 Set objOutlook = CreateObject(&quot;Outlook.Application&quot;)
 Set objNamespace = objOutlook.GetNamespace(&quot;MAPI&quot;)
 '受信トレイの取得
 Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
 '受信トレイの階層上位＝受信トレイ以外のフォルダ オブジェクト取得
 strFolderName = objInbox.Parent
 'メールボックスの全てのフォルダを取得
 Set objMailbox = objNamespace.Folders(strFolderName)
 '取得したいフォルダ名を指定
 '（本サンプルでは「下書きフォルダ」）
 Set objFolder = objMailbox.Folders(&quot;下書き&quot;)
 
 For i = 1 To objFolder.Items.Count
   If objFolder.Items(i).Class = 43 Then
       Cells(i + 1, 1).Value = objFolder.Items(i).SenderName
       Cells(i + 1, 2).Value = objFolder.Items(i).Subject
       Cells(i + 1, 3).Value = objFolder.Items(i).ReceivedTime
       Cells(i + 1, 4).Value = objFolder.Items(i).Body
    End If
  Next
  
  Set objOutlook = Nothing
  Set objNamespace = Nothing
  Set objInbox = Nothing
  Set objMailbox = Nothing

End Sub

本サンプルはこのOfficeギャラリーを参考にしていますが、簡単に言いますと「受信トレイ」を取得してから、その上位階層（受信トレイと同列）フォルダオブジェクトを取得して、その中から該当するフォルダ（本例では「下書き」）を指定し取得という流れです。

先ず冒頭にConst olFolderInbox = 6として定数設定していますが、これは「受信トレイ」フォルダタイプ＝６となっている為で、こちらに載っています。

次にSet objInbox = objNamespace.GetDefaultFolder(olFolderInbox)で受信トレイを取得して、次にstrFolderName = objInbox.Parentで受信トレイ以外のフォルダオブジェクトを取得していますので、ここで「下書き」などがobjMailboxに格納され、Set objFolder = objMailbox.Folders(“下書き”)で指定／取得します。（Parentプロパティとは階層関係上位のオブジェクトを返してくれるプロパティ）

ここまでで必要になるメールアイテムは取得できますので、後はSample1同様に指定セルに書込めばOKです。

4.Sample3:受信トレイ内のサブフォルダを指定する場合

本サンプルは「受信トレイ」内のサブフォルダを指定してメールを取得したいケースを想定していますが、おそらくこのケースが一番多そうです。

例として「受信トレイ」内に「Sub_Sample」フォルダを設けたので、そのフォルダを指定して同様にセルに書込んでみます。

'受信トレイ内サブフォルダを指定する場合
Sub Sample3()

 Const olFolderInbox = 6
 
 Dim objOutlook, objNamespace, objInbox, subFolder As Object
 Dim i As Long
 
 Set objOutlook = CreateObject(&quot;Outlook.Application&quot;)
 Set objNamespace = objOutlook.GetNamespace(&quot;MAPI&quot;)
 Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
 '取得したメールボックスフォルダ内にあるサブフォルダの
 '「Sub_Sample」を指定
 Set subFolder = objInbox.Folders(&quot;Sub_Sample&quot;)
 
 For i = 1 To subFolder.Items.Count
   If subFolder.Items(i).Class = 43 Then
       Cells(i + 1, 1).Value = subFolder.Items(i).SenderName
       Cells(i + 1, 2).Value = subFolder.Items(i).Subject
       Cells(i + 1, 3).Value = subFolder.Items(i).ReceivedTime
       Cells(i + 1, 4).Value = subFolder.Items(i).Body
    End If
  Next

  Set objOutlook = Nothing
  Set objNamespace = Nothing
  Set objInbox = Nothing

End Sub

「Sub Sample」フォルダには5件のメールがありますので、実行した結果は以下のように書き込まれます。

本サンプルの場合もSample2とほぼ同様なのですが、「受信トレイ」内のフォルダを指定しますので、Set subFolder = objInbox.Folders(“Sub_Sample”)を追加しています。

これにより指定フォルダ内のメールを取得しますので、後は同様にセルに転記する流れです。

5.Sample4:特定の送信者のみ取得する

これも環境によっては用途がありそうです。因みに私はこのパターンを使用することが多いです。サンプルでは「受信トレイ」内の特定の送信者だけをピックアップしてセルへ転記するものです。

'特定の送信者のみセルへ出力する場合
Sub Sample4()

 Const olFolderInbox = 6
 Dim objOutlook, objNamespace, objInbox As Object
 Dim i, cnt As Long
 cnt = 1

 Set objOutlook = CreateObject(&quot;Outlook.Application&quot;)
 Set objNamespace = objOutlook.GetNamespace(&quot;MAPI&quot;)
 Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
 
 '受信トレイ内のアイテム数分繰り返し処理
 For i = 1 To objInbox.Items.Count
   '重複するobjInbox.Items(i)をWithで省略する
   With objInbox.Items(i)
      'メールアイテム且つ差出人が指定する「○○」であれば実行
      If .Class = 43 And .SenderName = &quot;〇〇&quot; Then
         'cnt=セルの行に羅列する為に使用
         cnt = cnt + 1
         Cells(cnt, 1).Value = .SenderName
         Cells(cnt, 2).Value = .Subject
         Cells(cnt, 3).Value = .ReceivedTime
         Cells(cnt, 4).Value = .Body
      End If
    End With
  Next

  Set objOutlook = Nothing
  Set objNamespace = Nothing
  Set objInbox = Nothing

End Sub

見ていただければわかるように、差出人を条件分岐に加えただけですから、If .Class = 43 And .SenderName = “〇〇” Thenの○○に指定すればOKです。

見た目が多少異なってるのは、ここまで書いてきて何ですがobjInbox.Items(i)が何度も重複するので、Withを使って省略しているだけですので、これまでのサンプル同様に書くと以下になります。

For i = 1 To objInbox.Items.Count
   If objInbox.Items(i).Class = 43 And objInbox.Items(i).SenderName = &quot;○○&quot; Then
       cnt = cnt + 1
       Cells(cnt, 1).Value = objInbox.Items(i).SenderName
       Cells(cnt, 2).Value = objInbox.Items(i).Subject
       Cells(cnt, 3).Value = objInbox.Items(i).ReceivedTime
       Cells(cnt, 4).Value = objInbox.Items(i).Body
    End If
  Next

実行すれば指定した送信者のみが抽出されてセルへ書き込まれます。