回答編集履歴

2

念のため UnRead プロパティの判定を追記しました。

2024/06/11 04:46

投稿

sk.exe
sk.exe

スコア908

test CHANGED
@@ -111,6 +111,11 @@
111
111
 
112
112
  With Target
113
113
 
114
+ '既読メッセージである場合
115
+ If .UnRead = False Then
116
+ Exit Sub
117
+ End If
118
+
114
119
  '特定の送信者アドレスと一致していない
115
120
  If .SenderEmailAddress <> "アカウント@ドメイン" Then
116
121
  Exit Sub

1

Outlook.Items コレクションの ItemAdd イベントの使用例を追記しました。

2024/06/11 04:28

投稿

sk.exe
sk.exe

スコア908

test CHANGED
@@ -60,3 +60,75 @@
60
60
 
61
61
  End Sub
62
62
  ```
63
+
64
+ ### 別解
65
+ [Outlook.Application オブジェクトの NewMailEx イベント](https://learn.microsoft.com/ja-jp/office/vba/api/outlook.application.newmailex)ではなく、[Outlook.Items オブジェクトの ItemAdd イベント](https://learn.microsoft.com/ja-jp/office/vba/api/outlook.items.itemadd)を使用する場合。
66
+
67
+ ```vba
68
+ 'ThisOutlookSession モジュール
69
+ Option Explicit
70
+
71
+ 'WithEvents 変数の宣言
72
+ Private WithEvents MyInboxItems As Outlook.Items
73
+
74
+ 'Outlook アプリケーションの起動時イベント
75
+ Private Sub Application_Startup()
76
+
77
+ '受信トレイのアイテムコレクションへの参照を WithEvents 変数に渡す
78
+ Set MyInboxItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
79
+
80
+ End Sub
81
+
82
+ 'Outlook アプリケーションの終了時イベント
83
+ Private Sub Application_Quit()
84
+
85
+ '参照解放
86
+ Set MyInboxItems = Nothing
87
+
88
+ End Sub
89
+
90
+ '変数 MyInboxItems が参照するアイテムコレクションに 1 つ以上のアイテムが追加される時に発生するイベント
91
+ Private Sub MyInboxItems_ItemAdd(ByVal Item As Object)
92
+
93
+ '追加されたアイテムの分類処理
94
+ Call CategorizeMail(Item)
95
+
96
+ End Sub
97
+
98
+ 'メールアイテムの分類処理
99
+ Sub CategorizeMail(Target As Object)
100
+
101
+ If Target Is Nothing Then
102
+ Exit Sub
103
+ End If
104
+
105
+ '以下の条件のいずれかに該当する場合は分類しない
106
+
107
+ 'アイテムの種類がメールアイテムではない場合
108
+ If Not TypeOf Target Is Outlook.MailItem Then
109
+ Exit Sub
110
+ End If
111
+
112
+ With Target
113
+
114
+ '特定の送信者アドレスと一致していない
115
+ If .SenderEmailAddress <> "アカウント@ドメイン" Then
116
+ Exit Sub
117
+ End If
118
+
119
+ '本文に特定のキーワードが含まれていない
120
+ If Not .Body Like "*キーワード*" Then
121
+ Exit Sub
122
+ End If
123
+
124
+ '分類項目の設定
125
+ .Categories = "分類項目 オレンジ"
126
+ .Save
127
+
128
+ Debug.Print "受信日時:" & Format(.ReceivedTime, "yyyy/mm/dd hh:nn:ss")
129
+ Debug.Print "件名:" & .Subject
130
+
131
+ End With
132
+
133
+ End Sub
134
+ ```