Sub SetMailSortingRule()
Dim outlookRules As Outlook.Rules
Dim outlookRule As Outlook.Rule
Dim outlookRuleActions As Outlook.RuleActions
Dim outlookRuleAction As Outlook.RuleAction
Dim outlookMoveToFolder As Outlook.MoveOrCopyRuleAction
Dim outlookDisplayDesktopAlert As Outlook.DisplayRuleAction
Dim outlookStopProcessing As Outlook.StopRuleAction
' 既存の同じ名前のルールがあれば削除する
On Error Resume Next
Set outlookRules = Application.Session.DefaultStore.GetRules()
On Error GoTo 0
For Each outlookRule In outlookRules
If outlookRule.Name = "メール仕分けルール" Then
outlookRule.Delete
Exit For
End If
Next outlookRule
' メール仕分けルールを作成
Set outlookRules = Application.Session.DefaultStore.GetRules()
Set outlookRule = outlookRules.Create("メール仕分けルール", Outlook.OlRuleType.olRuleReceive)
Set outlookRuleConditions = outlookRule.Conditions
Set outlookRuleActions = outlookRule.Actions
' 条件: 件名に「xxx」が含まれる場合
With outlookRuleConditions.Subject
.Text = Array("xxx")
.Enabled = True
End With
' アクション: 新着アイテム通知ウィンドウにメールを表示する
Set outlookDisplayDesktopAlert = outlookRuleActions.Create(Outlook.OlRuleActionType.olRuleActionDisplayDesktopAlert)
outlookDisplayDesktopAlert.Text = "新着アイテム通知ウィンドウにメールを表示する"
' アクション: フォルダーへ移動する
Set outlookMoveToFolder = outlookRuleActions.Create(Outlook.OlRuleActionType.olRuleActionMoveToFolder)
outlookMoveToFolder.Folder = Application.Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox).Folders("YYY")
' アクション: デスクトップ通知を表示する
Set outlookDisplayDesktopAlert = outlookRuleActions.Create(Outlook.OlRuleActionType.olRuleActionDisplayDesktopAlert)
outlookDisplayDesktopAlert.Text = "デスクトップ通知を表示する"
' アクション: 仕訳ルールの処理を中止する
Set outlookStopProcessing = outlookRuleActions.Create(Outlook.OlRuleActionType.olRuleActionStop)
' ルールを保存
outlookRule.Enabled = True
outlookRules.Save
End Sub
