Outlook 刪除大量重覆信件

　　最近因為公司的 Exchange 系統轉換，因為容量變大，想說把之前因空間因素抓下來後就刪除的信件全匯回去，之後就可以透過線上直接閱覽舊信件，匯入時看到有重覆項目的處理選項，我也勾選了重覆項目不匯入，沒想到還是中了陷阱，雖然一封信頂多重覆一次，但重覆的信件高達上百封，要我手動砍... 也不是砍不完，就不知要花多少時間了，所以上網找解答！

　　我本來有找到 ODIR ，但是這個不適用 64bit Office ，且也不支援新版的 Office (這次趁換 Exchange ，我也把我的 Office 從 2010 升到 2016 了！)，所以直接 Pass 掉，不過如果仍用舊版的，可以不用像我這麼辛苦的找了XD
　　後來找到微軟討論區也有相關的提問並且被解答了，是使用 VBA 來解決這個問題的，很好，這很明顯就是我需要的答案，不過因為 VBA 我很久沒用了，還真著實卡了一下下，以下是紀錄：

1. 如何開啟巨集並將指令貼到巨集中執行：
   於「檔案」->「選項」->「自訂功能區」/「快速存取工具列」->「[開發人員] 索引標籤」->將「巨集」或「程式碼」加到常用清單，就可以在常用清單上點選他並進行使用了
   因為我最後一次跑巨集用的 Office 還是萬年的 2003 ，選項位置完全不同，真的有困擾到我XD
2. 接下來將下列語法貼到指令視窗，並執行
   其中因為我要清理的目錄非預設目錄，所以多用了一些找目錄的語法，如果你的目錄只有一個且就是他的收件匣，那不需要像我這麼麻煩的！

    Sub 清理重覆信件()
'outLook2007版本驗證，使用前請調低安全性。
    Dim olApp       As New Outlook.Application
    Dim olNs        As Outlook.NameSpace
    Dim fld         As Outlook.Folder
    Dim fld_Inbox   As Outlook.Folder
    Dim objItems    As Outlook.Items
    Dim myItem      As Object
    Dim dupItem     As Object
    Dim i           As Long
    Dim ThisSenderEmailAddress, NextSenderEmailAddress As String
    Dim ThisSize, NextSize As Long
    Dim ThisSentOn, NextSentOn As Date
    Dim ThisBody, NextBody As String
    Set olNs = olApp.GetNamespace("MAPI")
    'Set fld_Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set fld = olNs.Folders.Item(1)
    For i = 1 To fld.Folders.Count
        If fld.Folders.Item(i).Name = "收件匣" Then
            Set fld_Inbox = fld.Folders.Item(i)
        End If
    Next
    
    Set objItems = fld_Inbox.Items
    '按發信時間過濾列表，
    'Set objItems = objItems.Restrict("[SentOn] > '8/1/2014'")

    objItems.Sort "[SentOn]", True
    Set myItem = objItems.GetFirst

    i = 0
    Do While TypeName(myItem) <> "Nothing"
        If TypeName(myItem) = "MailItem" Then
            ThisSenderEmailAddress = myItem.SenderEmailAddress '發信人信箱
            ThisSize = myItem.Size '信件大小
            ThisSentOn = myItem.SentOn '發信時間,如"2015/8/28 9:57:02"
            ThisBody = myItem.Body '郵件本文內容

            Set dupItem = objItems.GetNext
            If TypeName(dupItem) = "MailItem" Then
                NextSenderEmailAddress = dupItem.SenderEmailAddress
                NextSize = dupItem.Size
                NextSentOn = dupItem.SentOn
                NextBody = dupItem.Body

                '刪除發信人、發信時間與郵件內容完全相同的信件。
                If ThisSenderEmailAddress = NextSenderEmailAddress And ThisSentOn = NextSentOn And ThisBody = NextBody Then
                    dupItem.Delete
                    i = i + 1
                Else
                    Set myItem = dupItem
                End If

            Else
                Set myItem = dupItem
            End If
        Else
           Set myItem = objItems.GetNext
        End If
    Loop
    
    
End Sub

---

Reference:
[1] ODIR: http://www.vaita.com/odir.asp
[2] Outlook 2016 刪除重複信件 - Microsoft Community