Outlook VBAで特定のフォルダのメールを開封済みにする。

はじめに

やりたいことは表題の通り。最初は仕訳ルールを使って開封済みにしていたが、開封済みにする動作はクライアントルールの為か、休みの間に数万件とか溜まっていると勝手に開封をあきらめやがる正常に動作しなかった（そもそも数日で万単位で飛んでくるメールて何！？）。
フォルダ移動はできているので開封済みにしなくても支障はないんだけど、圧がすごいので何とかならないか調べたらOutook VBAなるもので出来るようだったので調べながら実装。

仕様

上記でも記載した通り、フォルダ移動は仕訳ルールで問題なく処理できている為、未読メールを開封済みにする処理をVBAにやらせる。

開封したいフォルダは1つではないので、特定のフォルダの配下にあるフォルダの中にあるメールを開封済みにするようにした。
具体的には「開封」フォルダを作って、開封済みにしたいフォルダをその配下に置けば勝手に開封済みにしていってくれる。

実装

MailOpen

Private Sub Application_NewMail()

        Dim mail As Object
        Dim myNameSpace As NameSpace
        Dim myInbox As Object
        Dim folder As folder
        Dim strFilter As String
        Dim word As String

        word = "開封"
        strFilter = "[UnRead] = True"
        Set myNameSpace = GetNamespace("MAPI")
        Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders(word).Folders '・・・1

        For Each folder In myInbox '・・・2

            While folder.UnReadItemCount <> 0 '・・・5

                For Each mail In folder.Items.Restrict(strFilter) '・・・3

                    mail.UnRead = False '・・・4

                Next mail
                Set folder = myNameSpace.GetDefaultFolder(olFolderInbox).Folders(word).Folders(folder.Name) '・・・6

            Wend

        Next

End Sub

解説

1. 変数wordのフォルダ名（今回は「開封」）のフォルダ配下のフォルダ共を変数に入れている。

2. myInboxの中をループ。つまり「開封」フォルダの配下のフォルダを順番に確認してる。

3. 対象フォルダ内の未読メールを順番に処理。Restriictでフィルタかけないととんでもないことになる。

4. [Unread]をFalseにしてる。それだけ。

5. なんでか知らないけど、3.のForEachだけだと全部開封されない（だれか原因おしえてください）ので未読がある限りループさせるようにした。

6. folderが動的じゃないようなので、フォルダの状況を取得しなおしてる。これがないと無限ループする。

おわりに

やりたいことはできたけど、未読が千超えると処理がめっちゃ遅い。おとなしく手動で「すべて開封済みにする」をしたほうが早い。

なんか腑に落ちない部分が多いので暇なときに調べて改善するかもです。
こうしたほうがいいよとか教えてくれるとたぶんすんごい喜びます。