vba - Remove duplicate Outlook items from a folder -

issue

1. outlook 2016 corrupted while moving items online archive pst file.
2. the pst file has been recovered .... many items (~7000) duplicated 5 times
3. there range of item types, standard messages, meeting requests etc

what tried
looked @ existing solutions , tools, including:

1. duplicate removal tools - none of free other trial option remove 10 items @ time.
2. a variety of code solutions including:
   jacob hilderbrand's effort runs excel
   macro in outlook delete duplicate emails-

i decided go code route relatively simple , gain more control on how duplicates reported.

i post self solution below may others.

i see other potential approaches (perhaps powershell) fixing problem may better mine.

the approach below:

1. provides users prompt select folder process
2. checks duplicates on base of subject, sender, creationtime , size
3. moved (rather delete) duplicates sub-folder (removed items) of folder being processed.
4. create csv file - stored under path in strpath create external reference outlook of emails have been moved.

updated: checking size surprisingly missed number of dupes, otherwise identical mail items. have changed test subject , body

tested on outlook 2016

const strpath = "c:\temp\deleted msg.csv" sub deleteduplicateemails()  dim lngcnt long dim objmail object dim objfso object dim objtf object  dim objdic object dim objitem object dim olapp outlook.application dim olns namespace dim olfolder folder dim olfolder2 folder dim strcheck 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 nothing exit sub  on error resume next set olfolder2 = olfolder.folders("removed items") on error goto 0  if olfolder2 nothing set olfolder2 = olfolder.folders.add("removed items")   lngcnt = olfolder.items.count 1 step -1  set objitem = olfolder.items(lngcnt)  strcheck = objitem.subject & "," & objitem.body & "," strcheck = replace(strcheck, ", ", chr(32))      if objdic.exists(strcheck)        objitem.move olfolder2        objtf.writeline replace(objitem.subject, ", ", chr(32))     else         objdic.add strcheck, true     end if next  if objtf.line > 2     msgbox "duplicate items removed ""removed items""", vbcritical, "see " & strpath & " details" else     msgbox "no duplicates found" end if end sub