arrays - Macro in Outlook to delete duplicate emails- -

public sub remdups()  dim t items, _     integer, _     arr collection, _     f folder, _     parent folder, _     target folder, _     milast mailitem, _     mi mailitem  set parent = application.getnamespace("mapi").pickfolder set target = application.getnamespace("mapi").pickfolder   each f in parent.folders     set t = f.items     t.sort "[subject]"     = 1     set milast = t(i)     set arr = new collection     while < t.count         = + 1         if typename(t(i)) = "mailitem"             set mi = t(i)             if milast.subject = mi.subject , milast.body = mi.body _             , milast.receivedtime = mi.receivedtime                 arr.add mi             else                 set milast = mi             end if         end if     wend     each mi in arr         mi.move target     next mi next f  end sub 

set milast = t(i) gives "run-time error'440' array index out of bounds please help

this modified version founded in web (blog excelandaccess)

this code let pick folder search , delete duplicate items.

option explicit  'set reference microsoft scripting runtime tools, references.  sub deleteduplicateemailsinselectedfolder()  dim long dim n long dim message string dim items object dim appol object dim ns object dim folder object  set items = createobject("scripting.dictionary")  'initialize , instance of outlook set appol = createobject("outlook.application")  'get mapi name space set ns = appol.getnamespace("mapi")  'allow user select folder in outlook set folder = ns.pickfolder  'get count of number of emails in folder n = folder.items.count  'check each email starting last , working backwards 1 'loop backwards ensure deleting of emails not interfere subsequent items in loop = n 1 step -1      on error resume next     'load matching criteria variable     'this setup use sunject , body, additional criteria added if desired     message = folder.items(i).subject & "|" & folder.items(i).body          'check dictionary variable match         if items.exists(message) = true         'if item has been added delete duplicate         folder.items(i).delete     else         'in item has not been added add subsequent matches deleted         items.add message, true end if  next  exitsub:  'release object variables memory set folder = nothing set ns = nothing set appol = nothing  end sub 

a better version find duplicate e-mails in other folder in recursive mode.