選択したメールの差出人からのメールを特定のフォルダーに移動するルールを作成して実行するマクロ


コメントにて以下のご要望をいただきました。


仕分けルール設定のされていない宣伝メールについてご相談したく質問させていただきました。

毎回、都度新しい仕分けルールで
①受信トレイの中のメールを選択
②ルール → 仕分けメールの作成
③「差出人が次の場合」をチェック
④「アイテムをフォルダーに移動する」 ※ここで受信トレイの下位に「広告メール」というフォルダを事前に準備していますので、このフォルダを選択します。
⑤ルール作成後に、「現在のフォルダーにあるメッセージにこの仕分けルールを今すぐ実行する」をチェックし、OKをクリック
⑥ルール仕分け作成およびメールの移動が完了

都度やっているのですが、マクロ化は可能でしょうか?

大変恐れ入りますがOutlookのマクロの知識に乏しくご教示いただけると幸甚に存じます。
  何卒宜しくお願いいたします。


マクロでルールを作成するには、まず、Session オブジェクトの DefaultStore プロパティの GetRules を使用して、既定のストアのルール一覧を Rules コレクションとして取得します。
次に、Rules の Create メソッドで受信時のルールを意味する olRuleReceive を指定して新規ルールを作成します。

作成したルールに条件を追加するには、取得した Rule オブジェクトの Conditions コレクションから  From プロパティを使用して ToOrFromRuleCondition オブジェクトを取得します。
そして、このオブジェクトの Enabled プロパティを True にして有効化し、Recipients プロパティの Add メソッドでメールの差出人のアドレスと表示名を追加した後で ResolveAll メソッドにより名前解決を行います。

また、ルールにアクションを追加するには、同じ Rule オブジェクトの Actions コレクションから MoveToFolder プロパティを使用してMoveOrCopyRuleAction オブジェクトを取得します。
そして、このオブジェクトの Enabled プロパティを True にして有効化し、Folder プロパティに移動先のフォルダーを設定します。

最後に、Rules オブジェクトの Save メソッドにより新しいルールを保存し、Rule オブジェクトの Execute メソッドで作成したルールを実行します。

実装すると以下のようなマクロになります。CreateRuleAndMove “フォルダー名” を実行するマクロを作成することで、他のフォルダーに移動するマクロも簡単に追加できます。

' ここをトリプルクリックでマクロ全体を選択できます。
' メールを選択して呼び出すマクロ
Public Sub MoveToKoukoku()
     ' フォルダー名を指定して実行
     CreateRuleAndMove "広告"
End Sub
' ルールを作成して実行するサブプロシージャ
Private Sub CreateRuleAndMove(strFolder As String)
     Dim objItem As MailItem
     Dim fldTarget As Folder
     Dim colRules As Rules
     Dim ruleNew As Rule
     Dim condFrom As ToOrFromRuleCondition
     Dim actMove As MoveOrCopyRuleAction
     ' メール一覧で選択されているメールを取得
     Set objItem = ActiveExplorer.Selection(1)
     ' ストアからルール一覧を取得
     Set colRules = Session.DefaultStore.GetRules()
     ' 差出人の名前でルールを作成
     Set ruleNew = colRules.Create(objItem.SenderName, olRuleReceive)
     ' 差出人の条件を作成
     Set condFrom = ruleNew.Conditions.From
     With condFrom
         ' 条件を有効化
         .Enabled = True
         ' 差出人のアドレスを条件に追加
         If objItem.SenderName = objItem.SenderEmailAddress Then
             .Recipients.Add objItem.SenderEmailAddress
         Else
             .Recipients.Add objItem.SenderName & _
                 " <" & objItem.SenderEmailAddress & ">"
         End If
         ' 差出人のアドレスを解決
         .Recipients.ResolveAll
     End With
     ' 移動先フォルダーを取得
     Set fldTarget = Session.GetDefaultFolder(olFolderInbox).Folders(strFolder)
     ' 移動のアクションを作成
     Set actMove = ruleNew.Actions.MoveToFolder
     With actMove
         ' アクションを有効化
         .Enabled = True
         ' 移動先フォルダーを指定
         .Folder = fldTarget
     End With
     ' ルールを保存
     colRules.Save
     ' 作成したルールを実行
     ruleNew.Execute True
End Sub

マクロの登録方法やメニューへの追加について

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト /  変更 )

Google フォト

Google アカウントを使ってコメントしています。 ログアウト /  変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト /  変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト /  変更 )

%s と連携中