未返信のメールを別のフォルダーに移動するマクロ

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

---

いつも参考にさせていただいています。

特定のフォルダにある未返信のメールをリストアップ、もしくは、所定のフォルダに移動させたいのです。VBAで実現する方法をアドバイスをいただければ幸いです。

---

メールが返信済みの場合、以下のようにプロパティが設定されます。

• PR_ICON_INDEX (メッセージ一覧で表示するアイコンの指定) が 261 (返信アイコン) に変わる
• PR_LAST_VERB_EXECUTED (メッセージに対して最後に実行された処理) が 102 (差出人に返信) または 103 (全員に返信) に変わる

そのため、この二つのプロパティをチェックして未返信かどうかの判断が可能です。
ただし、返信した後で同じメールを転送したような場合、上記のプロパティは転送を意味する値に上書きされます。
そのような状況でも返信済みかどうかを判断することは残念ながら困難です。

未返信のメールを別のフォルダーに移動するマクロは以下のようになります。

'
Public Sub MoveUnrepliedItems()
     Const PR_ICON_INDEX = "http:" & "//schemas.microsoft.com/mapi/proptag/0x10800003"
     Const PR_LAST_VERB_EXECUTED = "http:" & "//schemas.microsoft.com/mapi/proptag/0x10810003"
     Const ICON_REPLY = 261
     Const VERB_REPLYTOSENDER = 102
     Const VERB_REPLYALL = 103
     Const SRC_FOLDER = "処理前"
     Const DST_FOLDER = "未返信"
     '
     Dim fldInbox As Folder
     Dim fldSrc As Folder
     Dim fldDst As Folder
     Dim i As Integer
     Dim iIndex As Integer
     Dim iLastV As Integer
     '
     Set fldInbox = Session.GetDefaultFolder(olFolderInbox)
     Set fldSrc = fldInbox.Folders(SRC_FOLDER)
     Set fldDst = fldInbox.Folders(DST_FOLDER)
     '
     For i = fldSrc.Items.Count To 1 Step -1
         With fldSrc.Items(i).PropertyAccessor
             iIndex = .GetProperty(PR_ICON_INDEX)
             iLastV = .GetProperty(PR_LAST_VERB_EXECUTED)
         End With
         If iIndex = ICON_REPLY Or iLastV = VERB_REPLYTOSENDER Or iLastV = VERB_REPLYALL Then
             '
         Else
             fldSrc.Items(i).Move fldDst
         End If
     Next
End Sub

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