outlook vba 分類項目の変更が保存されない

Question

実現したいこと

outlook vbaで分類項目を変更してメールを保存したい

発生している問題・分からないこと

分類項目を変更して、メールを保存しようとするとエラーが表示されます。
分類項目の変更は、メール受信したイベントで行っています。

エラーメッセージ

メッセージが変更されたために、機能は実行できません
とエラーメッセージが表示されます

該当のソースコード

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)

objId.Categories = "test"
objId.Save

End Sub

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

エラーメッセージで調べましたが、解決する内容が見つかりませんでした

補足

※デバッグしたところ、エラーになる場合とならない場合がありました。
おおよそですが、４割ぐらいがエラーになっていました。メールは、大量の受信する場合もあって、仕分けルールも大量にあります。
application_NewMailexのイベントで、分類項目を変更していますが、その後、仕分けルールで格納フォルダを変更していたりとしています。なので、分類項目を保存する前に、仕分けルールによってメッセージが変更されて保存ができないということはありますでしょうか。

Comments

[sk.exe]

> application_NewMailexのイベントで、分類項目を変更していますが、
> その後、仕分けルールで格納フォルダを変更していたりとしています。
> なので、分類項目を保存する前に、仕分けルールによってメッセージが
> 変更されて保存ができないということはありますでしょうか。

Application.NewMailEx イベント (Outlook):
https://learn.microsoft.com/ja-jp/office/vba/api/outlook.application.newmailex

> クライアント コンピューターの設定によっては、新しいメッセージが
> 受信トレイに配信された後に、迷惑メールのフィルター処理や、
> クライアント ルールによって新しいメッセージを受信トレイから
> 別のフォルダーへ移動する処理などが、非同期に実行される場合もあります。
> これらのイベントが発生した後、受信トレイ内のアイテム数が常に 1 項目
> 増加すると想定しないでください。

Answer 1

分類項目の変更は、メール受信したイベントで行っています。

'受信トレイに新しいアイテムを受信する時に発生するイベント
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

    Dim varEntryIDs As Variant
    Dim objItem As Object
    Dim i As Long

    '受信したアイテムのエントリIDを1次元配列に変換
    varEntryIDs = Split(EntryIDCollection, ",")

    '全てのエントリIDを1つずつ走査
    For i = LBound(varEntryIDs) To UBound(varEntryIDs)
        '受信したアイテムを参照
        Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
        'メールアイテムの分類処理
        Call CategorizeMail(objItem)
        '参照解放
        Set objItem = Nothing
    Next

End Sub

'メールアイテムの分類処理
Sub CategorizeMail(Target As Object)

    If Target Is Nothing Then
        Exit Sub
    End If

    '以下の条件のいずれかに該当する場合は分類しない

    'アイテムの種類がメールアイテムではない場合
    If Not TypeOf Target Is Outlook.MailItem Then
        Exit Sub
    End If

    With Target

        '特定の送信者アドレスと一致していない
        If .SenderEmailAddress <> "アカウント@ドメイン" Then
            Exit Sub
        End If

        '本文に特定のキーワードが含まれていない
        If Not .Body Like "*キーワード*" Then
            Exit Sub
        End If
        
        '分類項目の設定
        .Categories = "分類項目 オレンジ"
        .Save
        
        Debug.Print "受信日時:" & Format(.ReceivedTime, "yyyy/mm/dd hh:nn:ss")
        Debug.Print "件名:" & .Subject
        
    End With

End Sub

別解

Outlook.Application オブジェクトの NewMailEx イベントではなく、Outlook.Items オブジェクトの ItemAdd イベントを使用する場合。

'ThisOutlookSession モジュール
Option Explicit

'WithEvents 変数の宣言
Private WithEvents MyInboxItems As Outlook.Items

'Outlook アプリケーションの起動時イベント
Private Sub Application_Startup()
    
    '受信トレイのアイテムコレクションへの参照を WithEvents 変数に渡す
    Set MyInboxItems = Application.Session.GetDefaultFolder(olFolderInbox).Items

End Sub

'Outlook アプリケーションの終了時イベント
Private Sub Application_Quit()
    
    '参照解放
    Set MyInboxItems = Nothing

End Sub

'変数 MyInboxItems が参照するアイテムコレクションに 1 つ以上のアイテムが追加される時に発生するイベント
Private Sub MyInboxItems_ItemAdd(ByVal Item As Object)

    '追加されたアイテムの分類処理
    Call CategorizeMail(Item)

End Sub

'メールアイテムの分類処理
Sub CategorizeMail(Target As Object)

    If Target Is Nothing Then
        Exit Sub
    End If

    '以下の条件のいずれかに該当する場合は分類しない

    'アイテムの種類がメールアイテムではない場合
    If Not TypeOf Target Is Outlook.MailItem Then
        Exit Sub
    End If

    With Target

        '既読メッセージである場合
        If .UnRead = False Then
            Exit Sub
        End If

        '特定の送信者アドレスと一致していない
        If .SenderEmailAddress <> "アカウント@ドメイン" Then
            Exit Sub
        End If

        '本文に特定のキーワードが含まれていない
        If Not .Body Like "*キーワード*" Then
            Exit Sub
        End If
        
        '分類項目の設定
        .Categories = "分類項目 オレンジ"
        .Save
        
        Debug.Print "受信日時:" & Format(.ReceivedTime, "yyyy/mm/dd hh:nn:ss")
        Debug.Print "件名:" & .Subject
        
    End With

End Sub

Comments

[nmmtkybb]

回答ありがとうございます。
MyInboxItems_ItemAddイベントで行えるか試してみたいと思います　

[sk.exe]

ItemAdd イベントに関してはあくまで NewMailEx の代替イベントとして例示したに過ぎず、「受信トレイに配信された後に、迷惑メールのフィルター処理や、クライアント ルールによって新しいメッセージを受信トレイから別のフォルダーへ移動する処理などが、非同期に実行される」よりも早く実行されることを必ずしも保証するものではありません。
非同期実行された仕分け処理の方が先に実行されることにより、受信トレイの Items の ItemAdd イベントが発生しないことも充分にあり得ます。

そもそも「ある条件に該当する受信メールに対して任意の分類項目を設定する」という処理自体は、そういう処理を自動実行する仕分けルールを作成し、「受信メールを任意のフォルダに移動する」処理を実行するルールよりも優先度を高くしておけば充分でしょう。

その実行条件がよほど（仕分けルールでは設定不可能なほどに）特殊でない限りは、無理にVBAによって同様の処理を実行しようとしなくてもよいはずです。

[nmmtkybb]

回答ありがとうございます。もう一度、見直してみます。
仕分けルールで設定がわからなかったため、vbaで組み合わせてみてはと考えて質問させていただきました。
受信日時が本日の場合のみ、仕分けルールによって、デスクトップ通知させようと考えていました。
仕分けルールでは、デスクトップ通知ができていますが、受信日時が過去分のものも、デスクトップ通知されてしまっていました。よって、受信日時が本日の場合は、分類項目の設定を行って、仕分けルールに条件を追加させてデスクトップ通知しようと考えていました。時々しかパソコンを触れないので、今の設定を変えずに考えていました。いろいろと見直してみます。