「重複したメールを削除するマクロ」への5件のフィードバック

1. ちょうど欲しかったマクロで大変ありがたいです。
   早速使用してみたのですが、インデックスが有効範囲外とのエラーが出るときがあります。
   Deleteされる対象メールがフォルダ末尾のメールだったときにそうなるような気がします。
   お手数ですがご確認いただけますでしょうか。使用環境はWin7+Outlook2010です。

   返信

2. ずっと探していた機能なので非常に助かります。
   マクロを実行した際、一度の実行で1つの重複メールが削除されるのですが、
   フォルダー内のすべての重複メールをまとめて削除できないでしょうか。
   (Windows8＋outlook2013です。）

   返信

3. 私も本マクロを使用して、”インデックスが有効範囲外”のエラーが出ましたので調査して修正してみました。

   ＜エラー発生理由＞
   本プログラムでは、ループ変数に i と j の2つを使っています。
   i は、比較元のアイテムを、j は比較対象のアイテムを参照するための配列番号として使用されています。
   　 今、仮に 11番目のアイテムと12番目のアイテムが重複していた場合、12番目のアイテムを削除します。
   　 削除後に処理が進むと、i がfor 分の中で+1 され12となり、12番目のアイテムを参照しようとしますが、
   　既に削除されたアイテムを参照しようとするので、上記のエラーとなるのだと思います。

   ＜対処＞
   　重複アイテムを削除した際に、アイテムのリスト作成とリストの受信時刻のソート処理を、再度行うことで
   　無効なアイテムへの参照が防げると思います。

   　また、元のソースでは、重複アイテムを削除後も重複アイテムを探すロジックとなっていますが、
   　重複メールが２通以上受信することはまずないと思われるため、処理の高速化のためには、
   　削除対象となったアイテムと同一のアイテムを更に見つける処理をやめてしまうのが良いと思います。
   　この２つの対処を行ったソースを以下に付けました。

   　一応私の環境では、エラーができずに複数のメールを削除できましたが、上記のエラー発生原因や
   　対処方法であっているでしょうか？

   　なお、私はVBAの初心者のため、誤って大事なメールが削除されることも考えられますので、下記
   　修正ソースをご利用される方は、ご自分の責任で使用してください。

   ＜修正ソース＞
   ‘ 重複したメールを削除するマクロ
   Public Sub RemoveDuplicateMessages()
   Dim colItems As Items
   Dim i As Integer
   Dim j As Integer
   Dim strMsgID As String
   Set colItems = ActiveExplorer.CurrentFolder.Items
   colItems.Sort “[受信日時]”, True
   For i = 1 To colItems.Count – 1
   strMsgID = colItems(i).PropertyAccessor.GetProperty(PR_INTERNET_MESSAGE_ID)
   For j = i + 1 To colItems.Count
   If colItems(j).PropertyAccessor.GetProperty(PR_INTERNET_MESSAGE_ID) = strMsgID Then
   If colItems(i).Body = colItems(j).Body Then
   colItems(j).Delete
   ‘ アイテムを削除したので、再取得及び再ソート　　　　　　　 ‘ エラー対処のため追加
   Set colItems = ActiveExplorer.CurrentFolder.Items　　 ‘ エラー対処のため追加
   colItems.Sort “[受信日時]”, True　　　　　　　　　　　　　　　 ‘ エラー対処のため追加
   　　　　　　　　 ‘ 高速化のため ｊ のループを脱出
   Exit For　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ‘ 高速化のため追加
   End If
   End If
   Next
   Next
   End Sub

   返信

4. 先程のソースで継続して重複チェックするようになったのは良かったのですが、
   2000アイテム程度のあるフォルダで実行したところ、いつになってもマクロが
   終了しないという問題が発生しました。
   VBAマクロを中断する方は、CTRL＋PAUSE（又はBRAKE) なんですね。
   初めて知りました。

   対応方法を検討してみました。

   ＜理由＞
   　重複が見つからないと、1つのアイテムに全アイテムのチェックを行うことになるため
   　全く重複がない場合、最もチェック回数が多くなってしまいます。

   　上記の私の場合ですと、
   　　1番目のアイテムの場合、2000-1 の1999回チェック。
   　2番目のアイテムの場合、1999-1 の1998回チェック。
   　　　：
   　といった具合です。

   ＜対処方法＞
   　アイテムのリストを一旦受信日でソートしていますので、重複アイテムは比較的
   　近い範囲でリストに合わられるはずです。

   　そこで、比較対象のアイテムが一定範囲以上離れたらば、その比較元のアイテムの
   　チェック処理は終了し、次のアイテムのチェック処理に行くようにしてみました。

   但し、まれに複数メールが一時に大量に受信されることはあると思いますので、
   　以下の場合、比較対象のアイテムの差を’5′ としています。

   　私の2000アイテム程度あるフォルダの環境で実行して、１分もかからずに終了
   　しましたが、この対処方法であっているでしょうか？

   　なお、私はVBAの初心者のため、誤って大事なメールが削除されることも考えられますので、
   　下記修正ソースをご利用される方は、ご自分の責任で使用してください。

   ＜修正ソース＞
   ‘ 重複したメールを削除するマクロ
   Public Sub RemoveDuplicateMessages()
   Dim colItems As Items
   Dim i As Integer
   Dim j As Integer
   Dim strMsgID As String
   Set colItems = ActiveExplorer.CurrentFolder.Items
   colItems.Sort “[受信日時]”, True
   For i = 1 To colItems.Count – 1
   strMsgID = colItems(i).PropertyAccessor.GetProperty(PR_INTERNET_MESSAGE_ID)
   For j = i + 1 To colItems.Count
   If colItems(j).PropertyAccessor.GetProperty(PR_INTERNET_MESSAGE_ID) = strMsgID Then
   If colItems(i).Body = colItems(j).Body Then
   colItems(j).Delete
   ‘アイテムを削除したので、再取得及び再ソート　　　　　　　’ エラー対処のため追加
   Set colItems = ActiveExplorer.CurrentFolder.Items　’ エラー対処のため追加
   colItems.Sort “[受信日時]”, True　　　　　　　　　　　　　　 ‘ エラー対処のため追加
   ‘ 高速化対応　　　　　　　　　　　　　　　　　　　　　　　　　　　 ‘ 高速化対応
   Exit For　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　’ 高速化対応
   End If
   End If
   ‘ 高速化対応　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　’ 高速化対応
   If (j > i + 5) Then　　　　　　　　　　　　　　　　　　　　　　　　　　　’ 高速化対応 一時点で同時に受信する可能性があるかにより、要調整
   　　 Exit For　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　’ 高速化対応
   End If　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　’ 高速化対応
   Next
   Next
   End Sub

   返信

5. はじめまして。
   Outlook2016で上記コードを実行したいと思っています。
   上記よりコピペ後、高速化のロジックを外して（重複が４件とかあるため）
   実行してみたところ、下記コードで止まってしまいました。

   strMsgID = colItems(i).PropertyAccessor.GetProperty(PR_INTERNET_MESSAGE_ID)

   イミディエイトで単独に実行すると、
   「実行時エラー’440′; 配列のインデックスが範囲内にありません。」

   と出ました。もし簡単に解決する方法があればご教示いただけると幸いです。
   （過去記事に対するコメントになり申し訳ありません）

   返信