仕事と予定の重複アイテムを削除するマクロ


メッセージで以下のようなご質問をいただきました。


ActiveSyncのエラーなどにより、Outlookの「仕事」や予定の項目が重複することがしばしばあります。
作成日時以外の内容が同一の項目などをすっきり削除するマクロは可能でしょうか。


どこまで同じ値のプロパティを持ったアイテムを重複とみなすかという点が問題になるかとは思いますが、以下のプロパティが同じ場合に重複とみなす、という基準でマクロを作ってみました。

仕事アイテム

件名、本文、期限、分類項目が同じものを重複とみなす

予定アイテム

件名、本文、開始日時、終了日時が同じものを重複とみなす

マクロは以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
'
Public Sub RemoveDuplicateTaskAndAppointments()
    Dim iCurFolder As Integer
    Dim fldCurrent As Object ' Folder
    Dim colItems As Items
    Dim i As Integer
    Dim j As Integer
    Dim bMatch As Boolean
    Dim objItem As Object
'
    iCurFolder = olFolderTasks ' 仕事フォルダから処理を開始
    While iCurFolder = olFolderTasks Or iCurFolder = olFolderCalendar
        Set fldCurrent = Session.GetDefaultFolder(iCurFolder)
        Set colItems = fldCurrent.Items
        colItems.Sort "[件名]" ' 件名で並び替え
        For i = colItems.Count To 2 Step -1
            For j = i - 1 To 1 Step -1
                If colItems(i).Subject = colItems(j).Subject Then ' 件名が同じなら他のプロパティの比較
                    bMatch = False
                    Select Case iCurFolder
                        Case olFolderTasks ' 仕事アイテムは本文、期限、分類項目を比較
                            If colItems(i).Body = colItems(j).Body And _
                             colItems(i).DueDate = colItems(j).DueDate And _
                             colItems(i).Categories = colItems(j).Categories Then
                                bMatch = True
                            End If
                        Case olFolderCalendar ' 予定アイテムは本文、開始日時、終了日時を比較
                            If colItems(i).Body = colItems(j).Body And _
                             colItems(i).Start = colItems(j).Start And _
                             colItems(i).End = colItems(j).End Then
                                bMatch = True
                            End If
                    End Select
                    If bMatch Then ' 一致したら最終更新日時が古いアイテムを削除
                        If colItems(i).LastModificationTime >= colItems(j).LastModificationTime Then
                            Set objItem = colItems(j)
                        Else
                            Set objItem = colItems(i)
                        End If
                        objItem.Delete
                    End If
                Else
                    Exit For ' 件名が一致しなければ次のアイテム
                End If
            Next
        Next
        If iCurFolder = olFolderTasks Then
            iCurFolder = olFolderCalendar
        Else
            iCurFolder = -1
        End If
    Wend
End Sub

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

仕事と予定の重複アイテムを削除するマクロ」への5件のフィードバック

  1. 初心者ですが、2010で実行をしたのですが結果が出ません。
    コピー、実行だけでは実況できないのでしょうか?
    教えていただけませんか?

  2. […] これを同一と判断するというロジックを組むのは極めて難しいと思われます。 しかし、インターネット上のメールは Message-ID という文字列で一意性が保たれるよう規約で決まっており、Message-ID が同じメールは基本的には同じメールと判断しても良いはずです。 そのため、Message-ID をもとに重複するメールを判断し、先に受信したメールを削除するというマクロを作ってみました。 なお、再送すると Message-ID が重複するという事例があるので、Message-ID だけでなく本文もチェックしています。 ちなみに、重複メールではなく、重複した仕事や予定を削除するマクロであれば、こちらにあります。 […]

  3. はじめまして。いつも参考にさせていただいております。中村と申します。
    さてOutlook2013を使ってまして、このマクロを使おうとすると以下のエラーが出ました。
    どういった修正が必要なのでしょうか。素人の質問で大変申し訳ありません。

    「実行時エラー’-2147221233 (8004010f)’:

    指定されたメッセージが見つかりません。」

    ちなみにgCalenderSyncというgoogleカレンダーとの同期ソフトを使っており、
    このソフトのエラーか何かで大量に重複予定ができてしまい、
    このマクロの適用を考えているところです。

    すみませんがよろしくお願いいたします。

    • おそらくはその同期ソフトによりメッセージが見つからないというような状況になっているのではないかと思います。
      残念ながらマクロでの対処は難しいでしょう。

コメントを残す

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

WordPress.com ロゴ

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

Twitter 画像

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

Facebook の写真

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

Google+ フォト

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

%s と連携中