[a_axe]

т.е. переместил, а дубликата я не нашёл »

Тут вероятен следующий вариант: код сравнивает тему письма и текст письма, не обращая внимания на емейл отправителя и время отправки, поэтому письма без текста с темой например "Re:" (или любыми другими одинаковыми) он будет считать дубликатами. Перемещает код вторую и последующие копии письма в пределах выбранной папки.
Можно сравнивать например также по email отправителя и времени отправки письма:

Код

Код:

Const strPath = "c:\temp\deleted msg.csv"
Sub DeleteDuplicateEmails_2()

Dim lngCnt As Long
Dim objMail As Object
Dim objFSO As Object
Dim objTF As Object

Dim objDic As Object
Dim objItem As Object
Dim olApp As Outlook.Application
Dim olNS As NameSpace
Dim olFolder As Folder
Dim olFolder2 As Folder
Dim strCheck As String

Set objDic = CreateObject("scripting.dictionary")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objTF = objFSO.CreateTextFile(strPath)
objTF.WriteLine "Subject"

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.PickFolder

If olFolder Is Nothing Then Exit Sub

On Error Resume Next
Set olFolder2 = olFolder.Folders("removed items")
On Error GoTo 0

If olFolder2 Is Nothing Then Set olFolder2 = olFolder.Folders.Add("removed items")


For lngCnt = olFolder.Items.Count To 1 Step -1

Set objItem = olFolder.Items(lngCnt)

strCheck = objItem.Subject & "," & objItem.Body & "," & objItem.SenderEmailAddress & "," & objItem.SentOn & ","
strCheck = Replace(strCheck, ", ", Chr(32))
    If objDic.Exists(strCheck) Then
       objItem.Move olFolder2
       objTF.WriteLine Replace(objItem.Subject, ", ", Chr(32))
    Else
        objDic.Add strCheck, True
    End If
Next

If objTF.Line > 2 Then
    MsgBox "duplicate items were removed to ""removed items""", vbCritical, "See " & strPath & " for details"
Else
    MsgBox "No duplicates found"
End If
End Sub

Попробуйте, отпишитесь по результатам.