asked on

how to remove duplicate email in outlook

how to remove duplex messages in the inbox of outlook 2007

ASKER CERTIFIED SOLUTION

Spydergt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

manuelflury

Hi,

Create in Inbox a subdir called sort_duplicate and another one called Temp

Execute the vbs script by double clicking on it.

Hope this helps

This is public domain !

Const olFolderInbox = 6
Const olFolderSentMail = 5
 
Const myfolder = "sort_duplicate"
 
Set MonApply = CreateObject("Outlook.Application") 
Set MonNSpace = MonApply.GetNamespace("MAPI")    'Bank MAPI
'Set FldDossier = MonNSpace.GetDefaultFolder(olFolderSentMail)    'Inbox Folder
Set FldDossier = MonNSpace.GetDefaultFolder(olFolderInbox)
 
Set MonDossier = MonNSpace.GetDefaultFolder(olFolderInbox)
 
dim icpt
icpt=0
dim nbmail
 
nbmail=FldDossier.Folders(myfolder).Items.Count
 
set dico = CreateObject("Scripting.Dictionary")
'msgbox FldDossier.Folders("Temp").Items.Count
 
'String init
strInfos = ""
'Loop to parse email
For i = 1 To nbmail
	'instantiate next email
		on error resume next
	  Set MonMail = FldDossier.Folders(myfolder).Items(i)
		if err.number=0 then
  	  'Get data from email
    	With MonMail
      	  strInfos = "Sender : " & .SenderEmailAddress
        	strInfos = strInfos & vbCr & "Recipients : " & .To
	        'strInfos = strInfos & vbCr & "Receipt_date : " & .ReceivedTime
					strInfos = strInfos & vbCr & "Size : " & .Size
    	End With
            
			if not dico.exists(strInfos) then
				dico.add strInfos, strInfos
			else
							icpt=icpt+1
							MonMail.move MonDossier.Folders("Temp")
			end if
		end if
		on error goto 0
Next 
		msgbox icpt & " emails moved to Inbox\Temp"

Open in new window

mail.zip