OUTLOOK VBA の件名に特定の文字列が含まれるメールが到着したらエクセルに本文を書き出す

Question

こんにちは。
OUTLOOK VBA初心者になります。

今回、
①件名(subject)に特定の文字が含まれるメールが到着したら(イベント)、
②自動でそのメールが開かれ、
③本文(body)内からテキストを抜き出し、
④予めデスクトップ上に存在するxlsmを開き、
⑤抜き出したテキストをセル(※ここではA1)に入力し、
⑥xlsmのA1の値が変更になった事をイベントとして、エクセルマクロ(既に完成している)が作動する

事を目指しています。
下記がOUTLOOK VBAの標準モジュール内に作成しているマクロになります。

まずは①～⑤に関してご指摘頂ければ幸いです。

【質問1】
件名に該当する文字列があるメールをテストで送信してみましたが、
debug.print "目的のメールが到着しました。" 　の時点で反応しておりません。

ここはコードの問題でしょうか？
別にいくつかの可能性が考えられるでしょうか？

【質問2】
MailItem.Display　は
実行時エラー'424'　オブジェクトが必要です。
となります。
ここで目的のメールを開くにはどのように指定するのが正しいでしょうか？

【質問3】
②でわざわざメールを開くと、
最後にメールを閉じる記述も必要になるように思いますが、
メールを開かずにメールから本文を抜き出す事も可能でしょうか？

【質問4】
最後にコード以外の質問で申し訳ありません。
今回この作業だけの為の端末に組み込む予定です。
(常時電源はつけっぱなし、outlookも開きっぱなし)
上記のような目的の場合は
outlookもxlsmもわざわざ開いて閉じてをせずに、両方とも開きっぱなしで動かすものでしょうか？

質問が多くなりましたが、どうかご指南お願いします。

---

Sub macro1()
    '①メールが到着したら件名に特定の文字(※●●●●●●●●)が「含まれるか」を判断し、含まれる場合だけ動作に進む。
    Dim objId As Object
    Set myNamespace = GetNamespace("MAPI")
    Set objId = myNamespace.GetItemFromID(EntryIDCollection)

    If InStr(objId.Subject, "●●●●●●●●") Then
        debug.print "目的のメールが到着しました。"
        '②到着した↑のメールを自動で開く
        MailItem.Display
        '③今まさに開いているメールオブジェクト本文の◇から始まる5文字を取得する
        Dim objItem As Object
        Dim objIns As Inspector
        Dim Ch_Lng1 As Long
        Dim mystr As String
        
        Set objIns = Application.ActiveInspector
        Set objItem = objIns.CurrentItem   
        
        Ch_Lng1 = InStr(objItem.Body, "◇")
        
        If Ch_Lng1 > 0 Then
            mystr = Mid(objItem.Body, Ch_Lng1, 5)
           
            Dim objExcel As Excel.Application
            Dim wb As Workbook
            Dim ws As Worksheet
            
            Dim strFile As String
           '④予めデスクトップ上に存在するxlsmを開く
            strFile = "C:\Users\〇〇〇〇〇\Desktop\▲▲▲▲▲▲.xlsm" 
            
            Set objExcel = New Excel.Application
            Set wb = objExcel.Workbooks.Open(strFile)
            Set ws = wb.Worksheets("Sheet1")
            ⑤抜き出したテキストをセル(※ここではA1)に入力
            ws.Range("A1") = mystr
        End If
    End If
End Sub

Comments

[meg_]

・コードは「コードの挿入」で記入してください。
・”MailItem”は質問のコード中では定義されていませんが、他のモジュール等で定義されているのでしょうか？

[mjxoxo]

ご指摘有難う御座います。
大変失礼しました。他のモジュールは挿入していませんので、上記のみになります。
DIM、SET含めどのように定義すれば期待するメールとなりますでしょうか？

[sinzo]

質問1は
https://extan.jp/?p=476
受信トレイに新規アイテムを受信したというきっかけを実現する
が参考のなりませんか

[sinzo]

https://tonari-it.com/outlook-vba-mailitem-body/
メール本文から目的の情報を取り出す
も参考に

[mjxoxo]

sinzo 様　有難う御座います。
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)に変更し正常に動くようになりました。
標準モジュールではなく、ThisOutlookSessionにコードを移動してうまくいきました。
Display部分もobjid.Displayで認識しました。
有難う御座います！

Answer 1

申し訳ございませんがOutlookの環境が無い為
VBAでのOutlook自動操作
と他サイトおよびVBAの知識でお答えします。
ご了承下さい。
あとOutlookのバージョン違いでも動かない可能性がありますので追記お願いします

【質問1】
【Outlook VBA】Application_NewMailExイベントでメール受信時にメッセージを表示する方法
こちらを参考になされたのでしょうか？
Application_NewMailExでのEntryIDCollectionは値が引き継がれていないのでは？
EntryIDCollectionの値はイベント発生時に通知されるので
Sub macro1()の引数指定などで対応して下さい。

Sub macro1(ByVal EntryIDCollection As String)
End Sub

あとobjId.Subjectの値をDebug.printするかMsgboxで表示してみて下さい

参考資料
NameSpace オブジェクト (Outlook)

【質問2】
MailItemとは変数定義も値の設定もない状態なので
実行時エラー'424'　オブジェクトが必要です。
となります。
objId.Bodyで値とれませんか？

【質問3】
「メールを開く」と「メールを開かなくても良い」と書いてある記述がありますね
もし開かずにobjId.Bodyで内容取得できれば「メールを開かなくても良い」のでは？

【質問4】
イベント処理なのでOutlookは立ち上げっぱなしになります。
（でないとメールを受信できない）
Excelは都度立ち上げているので

  Set objExcel = New Excel.Application      'Excelを起動
  Set wb = objExcel.Workbooks.Open(strFile) 'Excelのファイルを開く

  'この処理が抜けています
  wb.Close SaveChanges:=True　 'Excelのファイルを保存して閉じる
　Set wb = Nothing             '参照解除
　objExcel.Quit                'Excelを終了する
　Set objExcel = Nothing       '参照解除

逆にExcelファイルを直接開かないように！
開くときはファイルコピーを行って、コピーしたファイルを開くようにしてください。

Comments

[mjxoxo]

有り難う御座います！
無事疑問が晴れました！