【Outlook VBA】NewMailExイベントで受信したメールの内容をエクセルシートに書き出す方法

皆様こんにちは、ノグチです。

前回の記事では、OutlookのNewMailExイベントを使って、受信したメールが条件にマッチするものだったらメッセージを表示する方法をご紹介しました。

今回は、同じくこのNewMailExイベントで、受信したメールが条件にマッチするものだったら、メールの内容をエクセルシートに書き出す方法をご紹介していきます。

前回のおさらい
対象のメールフォーマットとエクセルシート
対象メールを受信したら内容をエクセルに書き出すコード
1. Outlookからエクセルを操作するための準備
2. 受信したメールから情報を取得してエクセルシートに書き出す
QuitメソッドでApplication終了を忘れずに！
イベントを使わない方法も考えてみる
最後に
連載目次：Outlook VBAでメールを操作してみよう

前回のおさらい

まずはOutlookのNewMailExイベントのおさらいをしましょう。

前回のコードはこちらでした。

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim myItem As Outlook.Items
Dim objId As Object

Set myNamespace = GetNamespace("MAPI")
Set objId = myNamespace.GetItemFromID(EntryIDCollection)

If InStr(objId.Subject, "日報") Then
    MsgBox "日報が届きました！"
End If

End Sub

メールのタイトルに『日報』という文字が含まれていたら、メールを受信したタイミングでメッセージを表示するというものでした。

イベント時に指定の処理をさせたい場合は、イベントプロシージャ内に処理を記述するのでしたね。

今回は、このメッセージ表示部分の処理を、メールの情報をエクセルシートに書き出す、という動作に置き換えていきますよ。

対象のメールフォーマットとエクセルシート

今回は、こちらのメールを対象にしてみましょう。

このメールの件名から年月日を、本文から作業時間と作業内容を取得して、こちらのエクセルシートに書き出していきます。

対象メールを受信したら内容をエクセルに書き出すコード

Outlookからエクセルを操作するための準備

Outlookからエクセルを操作するためにはまず、

参照設定
コード内でエクセルのApplicationオブジェクト取得

が必要です。

これについては下記記事で紹介していますので、ご覧ください。

【エクセルVBA】エクセルVBAでOutlookを操作しよう！参照設定とOutlookアプリケーションオブジェクトの取得

エクセルVBAでOutlookのメール送信やタスク作成操作をする前準備として、VBEの参照設定や、Outlookアプリケーションオブジェクトの取得方法をご紹介しています。 VBAとOutlookを組み合わせて使うことで、既に便利に使えているメーラーを更に便利にできるかもしれませんよ。

参照設定はしていなくてもOutlookからエクセルを操作することはできます。

しかしコードが長くなってしまうのと、参照設定をしたほうがコードの記述が楽、ということもあって、設定しておくのがオススメです。

では、エクセルのApplicationオブジェクトを取得し、書き出したいエクセルのファイルパスを指定しましょう。

上のコードに上記を書き足すと、こんな感じになります。

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim objId As Object

Set myNamespace = GetNamespace("MAPI")
Set objId = myNamespace.GetItemFromID(EntryIDCollection)

If InStr(objId.Subject, "日報") Then
    Dim strFile As String
    Dim objExcel As Excel.Application　

    strFile = "C:\Users\Desktop\日報リスト.xlsx"

    Set objExcel = New Excel.Application    ’エクセルのApplicationオブジェクトを取得
    Set wb = objExcel.Workbooks.Open(strFile)
    Set ws = wb.Worksheets("Sheet1")

End If
End Sub

NewMailExイベントは、対象にしたいメール以外を受信した時にも実行されます。

対象外のメールを受信した場合にはExcelオブジェクトを読込ませる必要は無いので、Excel関連の宣言やオブジェクト取得のコードはIF文の中に入れてしまっています。

受信したメールから情報を取得してエクセルシートに書き出す

メールの件名は、MailItemオブジェクトのSubjectプロパティで、メールの本文はBodyプロパティで取得することができます。

受信したメールのMailItemオブジェクトを取得する方法は、前回の記事でご紹介しました。

メール本文から欲しい情報を取り出す方法は、こちらの記事でご紹介しています。

【Outlook VBA】メール本文から欲しい情報だけを取り出す方法

MailItemオブジェクトのBodyプロパティとMid関数を使って、Outlookのメール本文から欲しい情報だけを取り出す方法をご紹介しています。メールで勤務時間を管理しているあなた！この方法なら、日々のチェックが楽になるかも？

これらを上のコードに加えると、こんな感じになります。

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim myNameSpace As NameSpace
Dim objId As Object

Set myNameSpace = GetNamespace("MAPI")
Set objId = myNameSpace.GetItemFromID(EntryIDCollection)

If InStr(objId.Subject, "日報") Then
    Dim strFile As String
    Dim objExcel As Excel.Application
        
    strFile = "C:\Users\ryoku\Desktop\日報リスト.xlsx"

    Set objExcel = New Excel.Application
    Set wb = objExcel.Workbooks.Open(strFile)
    Set ws = wb.Worksheets("Sheet1")

    With objId

        Dim lngLen As Long
        Dim lngLen2 As Long
        Dim lngLen3 As Long
        Dim lngLen4 As Long
        
        '作業日
        i = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        ws.Cells(i, 1).Value = Mid(objId.Subject, Len("【日報】") + 1, Len(objId.Subject) - Len("【日報】"))
        
        '作業時間
        lngLen = InStr(objId.Body, "【作業時間】") + Len("【作業時間】")
        lngLen2 = InStr(objId.Body, vbCrLf)
        
        ws.Cells(i, 2).Value = Mid(objId.Body, lngLen, lngLen2 - lngLen)
        
        '作業内容
        lngLen3 = InStr(objId.Body, "【作業内容】") + Len("【作業内容】")
        
        ws.Cells(i, 3).Value = Right(objId.Body, Len(objId.Body) - lngLen3)
    End With

wb.save
wb.Close
objExcel.Quit

End If
End Sub

対象メールを受信したら、メールの件名と本文から欲しい情報を取得し、「日報リスト.xlsx」というファイルを開いて、最下行に取得したメールの内容を書き出していく、というコードです。

そして、対象としたいメールを受信すると…