ExcelVBAでOutlookからメール受信 3

中級VBA

はじめに

 前回は、メールの移動と削除の方法を見てきました。前回の方法では「受信トレイ」フォルダーの全てのアイテムを巡回しながら処理を行いましたが、今回は特定のメールアイテムを指定して選択しい移動や削除を行う方法を紹介します。

 Outlookには、EntryIDという識別子があり、MAPI ベース(Namespace)で一意のIDが割り当てられています。

個別のアイテムを識別するID

 メールアイテムを識別するIDは、EntryIDプロパティで取得できます。
 Outlookの受信トレイにあるメールアイテムをExcelに表示するプログラムは以下の通りです。
 このプログラムでEntryIDを表示させて、得られた値からメールアイテムを個別に取得してみます。

'受信トレイの表示
Sub getMailFolder()
    Dim myNamespace As Outlook.Namespace
    Set myNamespace = Outlook.Application.GetNamespace("MAPI")
    
    Dim myFolder As Outlook.Folder
    Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
    
    Dim i As Long
    Dim olItem As Outlook.MailItem
   
    With myFolder
    
    For i = 1 To .Items.Count
        Set olItem = .Items(i)

        Cells(i, 1) = i
        Cells(i, 2) = olItem.ReceivedTime   '受信日時
        Cells(i, 3) = olItem.subject        '題名
        Cells(i, 4) = olItem.SenderName     '送信者名
        Cells(i, 5) = olItem.SenderEmailAddress     '送信メールアドレス
        Cells(i, 6) = Left(olItem.Body, 20)     '本文(先頭から20文字)
        Cells(i, 7) = olItem.EntryID        '識別ID
    Next
    
    End With
    
End Sub

識別ID(EntryID)からメールアイテムを取得する

 メールアイテムの配列である Items のインデックスからメールアイテムを取得する場合、新たなメールが追加されたり、移動や削除を行うと配列内の順番がズレてインデックス番号が変わる可能性が出てきます。
 EntryIDは一意の値ですので、個別のメールアイテムを取得する場合に便利です。
 
 EntryIDからメールアイテムを取得するには、GetItemFromIDメソッドを使います。
 以下のプログラムでは、先程表示させた一覧の識別IDからメールアイテムを取得して表示します。

Sub 特定のメールアイテムを表示する()
    Dim myNamespace As Outlook.Namespace
    Set myNamespace = Outlook.Application.GetNamespace("MAPI")
    
    Dim myFolder As Outlook.Folder
    Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)

    Dim i As Long
    Dim olItem As Outlook.MailItem
    
    With myFolder
    i = Selection(1).Row    '選択されたセルの行を取得
    Set olItem = myNamespace.GetItemFromID(ActiveSheet.Cells(i, 7))
    
    olItem.Display   'Outlookで表示
    
    End With
    
    End
    
End Sub

 尚、GetItemFromIDメソッドを使ったプロシージャを実行する場合、2回目に「リモートサーバがないか、使用できる状況ではありません」というエラーが発生する事があります。
 この対策として、最後に End 関数を実行し宣言したオブジェクトがクリアされるようにしています。

 エラーの詳細については、以下を参照してください。
 ・「リモートサーバがないか、使用できる状況ではありません」の対処法

 上記プロシージャは、End を実行するため、他のプロシージャから呼び出すと呼び出したプロシージャに返らなくなりますので注意してください。

取得したメールアイテムの所属するフォルダ名

 EntryIDからメールアイテムを取得できれば、現在どのフォルダーにあるかは、Parentプロパティで確認できます。
 以下のプログラムの myEntryID 部分をExcelに表示された一覧からコピーして貼り付けて実行してみてください。
 ”受信トレイ”と表示されると思います。
 次に、該当するメールをOutlookで他のフォルダに移動してから以下のプログラムを実行してみてください。
 今度は、移動先のフォルダ名が表示されると思います。
 
 尚、メールを [削除済みアイテム] から削除した場合は、メールアイテムを取得する所でエラーとなります。

Sub testMailItem()
    Dim myNamespace As Outlook.Namespace
    Set myNamespace = Outlook.Application.GetNamespace("MAPI")
    
    Dim myEntryID As String
    
    '(EntryIDを一覧からコピーして貼り付けてください)
    myEntryID = "00000000B06CE078A65CFC4F9A247D99677DB4D2A45F2500"
    
    Dim olItem As Outlook.MailItem
    Set olItem = myNamespace.GetItemFromID(myEntryID)
    
    Debug.Print olItem.Parent
    
    End

End Sub

まとめ

 EntryIDを取得すれば、メールアイテムを個別に扱う事ができます。EntryIDの取得には GetItemFromID を使いますが、このプロシージャを実行する際、「リモートサーバがないか、使用できる状況ではありません」というエラーが発生する事があります。
 対策として End 関数を実行しておきます。
 
 End 関数は、呼び出された先のプロシージャに戻らずプログラムを終了しますので注意してください。

タイトルとURLをコピーしました