【備忘メモ】VBA で Outlook の受信メールを取得する

# はじめに

Outlook の受信メールを VBA で取得することがが必要になりそうなので、自分用のメモとして残しておきます。

＜参考サイト＞
・[Outlook VBAのオブジェクトについて](https://extan.jp/?p=1459)
・[エクセルVBAでOutlookの受信メールをワークシートに書き出す方法](https://tonari-it.com/excel-vba-outlook-outputmail/)
・[Microsoftの分かりにくい公式サイト](https://docs.microsoft.com/ja-jp/office/vba/api/overview/outlook)

# 1. 参照設定

VBAメニューの「ツール」から「参照設定」を開き、`Microsoft Outlook X.X Object Library`にチェックを入れてOKボタンを押します。
![2021-04-25 193037.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/551412/186c5502-7b7a-3645-ef82-f68c334e5d23.png)

# 2. 受信トレイのメールを取得するサンプルコード

受信トレイ（サブフォルダを除く）のメールを全て取得して、Excelのシートに書き出すサンプルコードです。

Excel VBA であれば、コピペでそのまま動くと思いますが、**お薦めしません**。
全件取得して、Excelシートに書き出すので時間が掛かるためです（処理速度を上げるなら「[こちらのサイト](https://hamalabo.net/excel-vba-speedup)」を参照）。
試しに実行するのであれば、For 文のところを `For i = 1 To 10` などとして、取得数を限定して実行することをお薦めします。

```vb:受信トレイのメールを取得
Sub GetOutlookReceivedEmail()
    'Outlookを操作するインスタンス取得
    Dim objOutlook As New Outlook.Application
    
    'Outlook の NameSpace オブジェクトを取得
    Dim myNamespace As Outlook.Namespace
    Set myNamespace = objOutlook.GetNamespace("MAPI")
    
    '受信トレイフォルダーを取得
    Dim myFolder As Folder
    Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
    
    '[Sheet1]のオブジェクトを取得
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim i As Long
    For i = 1 To myFolder.Items.Count '受信トレイのメール数だけループする
        On Error Resume Next '取得時にエラーが出る場合を回避（配信不能のお知らせメールなど）
        
        ws.Cells(i, 1).Value = myFolder.Items.Item(i).SenderName '送信者名
        ws.Cells(i, 2).Value = myFolder.Items.Item(i).SenderEmailAddress '送信者アドレス
        ws.Cells(i, 3).Value = myFolder.Items.Item(i).ReceivedByName '受信者名
        ws.Cells(i, 4).Value = myFolder.Items.Item(i).To 'To（表示名）
        ws.Cells(i, 5).Value = myFolder.Items.Item(i).CC 'CC（表示名）
        ws.Cells(i, 6).Value = myFolder.Items.Item(i).BCC 'BCC（表示名）
        ws.Cells(i, 7).Value = myFolder.Items.Item(i).ReceivedTime '受信時間
        ws.Cells(i, 8).Value = myFolder.Items.Item(i).SentOn '送信時間
        
        ws.Cells(i, 9).Value = myFolder.Items.Item(i).Subject '件名
        ws.Cells(i, 10).Value = myFolder.Items.Item(i).Body '本文
        
        If Err.Number > 0 Then
            ws.Cells(i, 11).Value = Err.Number & ", " & Err.Description 'とりあえずエラーも表示しておこう
        End If
        
        On Error GoTo 0
    Next
End Sub
```

## 簡単な説明

①～③は定型です。

**① Outlookオブジェクト取得**
最初の1行で、Outlookを操作するインスタンスを取得しています。

**② NameSpace オブジェクト取得**
名前空間"MAPI"を使用すれば、Outlook の [NameSpace オブジェクト](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.namespace) を取得できます。
これにより、「ユーザーのメッセージ ストアに格納されたすべての Outlook データへアクセスでき」るとのことです（[公式の注釈](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.namespace#remarks)）。

**③ 受信トレイフォルダーのオブジェクト取得**
[GetDefaultFolder メソッド](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.namespace.getdefaultfolder)を使用して「受信トレイフォルダ」のオブジェクトを取得します。
引数の `olFolderInbox` は「受信トレイフォルダ」を取得することを意味します。

なお、送信トレイは `olFolderOutbox` となります。他のフォルダを取得することはあまりないと思いますが、必要があれば「[OlDefaultFolders enumeration](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.oldefaultfolders)」を参照してみてください（記載されている数値を引数に入れても OK です）。

**④ WorkSheetのオブジェクト取得**
書き込み先のExcelシートを指定しています。
実在するシート名を指定します。

**⑤ メールの情報を取得してシートに書き出し**
For 文のところです。
必要そうなプロパティを適当に選択しています。

|プロパティ|内容|備考|
|---|---|---|
|SenderName|送信者名||
|SenderEmailAddress|送信者アドレス||
|ReceivedByName|受信者名||
|To|To（表示名）|アドレスでなく表示名です|
|CC|CC（表示名）|アドレスでなく表示名です|
|BCC|BCC（表示名）|受信トレイだと取得できないと思います|
|ReceivedTime|受信時間||
|SentOn|送信時間||
|Subject|件名||
|Body|本文||
|HTMLBody|HTML形式の本文||
 
**⑥ エラー処理**
例えば、**配信不能**のお知らせメールなどは、件名、本文などの情報しか取得できません。
取得できない情報にアクセスしようとするとエラーが出ます。
そのため、`On Error Resume Next` を使用して、エラーが出ても処理を続けるようにしています。

＜参考サイト＞
・[Outlook.MailItemから送信者のメールアドレスを取得する](https://qiita.com/nukie_53/items/23b46841b291125cbab4)

# 3. サブフォルダの名前の取得

受信トレイのメールだけ取得しても、必要条件を充たさない場合があります。
その場合は、サブフォルダのメールも取得する必要があります。

とりあえず、サブフォルダの名前と、フォルダ内にあるメール数を取得するコードを書くと次のようになります。

```vb
Sub GetSubFolderName()
    'Outlookを操作するインスタンス取得
    Dim objOutlook As New Outlook.Application

    'Outlook の NameSpace オブジェクトを取得
    Dim myNamespace As Outlook.Namespace
    Set myNamespace = objOutlook.GetNamespace("MAPI")

    '受信トレイフォルダーを取得
    Dim myFolder As Folder
    Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
    
    'サブフォルダの名前とメール数を取得
    Dim i As Long
    Dim mySubFolder As Folder
    For i = 1 To myFolder.Folders.Count
        Set mySubFolder = myFolder.Folders(i)
        Debug.Print mySubFolder.Name
        Debug.Print mySubFolder.Items.Count
    Next
End Sub
```

受信トレイフォルダのオブジェクトのFolders プロパティを使用することで、サブフォルダのリスト（[Folders オブジェクト](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.folders)）を取得することができます。

For 文のところで、Folders オブジェクトから1つずつ、サブフォルダの [Folder オブジェクト](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.folder) を取得して、[サブフォルダ名](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.folder.name)と、格納している[メール数](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.items.count)を取得しています。

# 4. サブフォルダのメールを取得するサンプルコード

以上の内容を踏まえて、サブフォルダの受信メールを取得するサンプルコードを書くと次のとおりです。

```vb
Sub GetOutlookReceivedEmailFromSubFolder()
    'Outlookを操作するインスタンス取得
    Dim objOutlook As New Outlook.Application

    'Outlook の NameSpace オブジェクトを取得
    Dim myNamespace As Outlook.Namespace
    Set myNamespace = objOutlook.GetNamespace("MAPI")

    '受信トレイフォルダーを取得
    Dim myFolder As Folder
    Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)

    '[Sheet1]のオブジェクトを取得
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim i As Long, j As Long, tmp As Long: tmp = 0
    Dim mySubFolder As Folder
    For i = 1 To myFolder.Folders.Count
        Set mySubFolder = myFolder.Folders(i) 'サブフォルダのオブジェクトを1つずつ取得
        
        For j = 1 To mySubFolder.Items.Count '受信トレイのメール数だけループする
            On Error Resume Next '取得時にエラーが出る場合を回避（配信不能のお知らせメールなど）
    
            ws.Cells(j + tmp, 1).Value = mySubFolder.Items.Item(j).SenderName '送信者名
            ws.Cells(j + tmp, 2).Value = mySubFolder.Items.Item(j).SenderEmailAddress '送信者アドレス
            ws.Cells(j + tmp, 3).Value = mySubFolder.Items.Item(j).ReceivedByName '受信者名
            ws.Cells(j + tmp, 4).Value = mySubFolder.Items.Item(j).To 'To（表示名）
            ws.Cells(j + tmp, 5).Value = mySubFolder.Items.Item(j).CC 'CC（表示名）
            ws.Cells(j + tmp, 6).Value = mySubFolder.Items.Item(j).BCC 'BCC（表示名）
            ws.Cells(j + tmp, 7).Value = mySubFolder.Items.Item(j).ReceivedTime '受信時間
            ws.Cells(j + tmp, 8).Value = mySubFolder.Items.Item(j).SentOn '送信時間（たぶん）
    
            ws.Cells(j + tmp, 9).Value = mySubFolder.Items.Item(j).Subject '件名
            ws.Cells(j + tmp, 10).Value = mySubFolder.Items.Item(j).Body '本文
    
            If Err.Number > 0 Then
                ws.Cells(j + tmp, 11).Value = Err.Number & ", " & Err.Description 'とりあえずエラーも表示しておこう
            End If
    
            On Error GoTo 0
        Next
        tmp = tmp + j - 1
    Next
End Sub
```

# さいごに

実際の業務では、受信日時（ReceivedTime）や、件名（Subject）などで絞り込みを行った上で、メールを取得することになると思います。
また、サブフォルダのサブフォルダを取得する場合は、再帰処理などを使用すれば、うまくいきそうです。