• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 609
  • Last Modified:

how to remove duplicate email in outlook

how to remove duplex messages in the inbox of outlook 2007
1 Solution
you can try this
Use the following steps to Delete Outlook duplicate email messages:

1. On the View menu, point to Current View, and then click to change the folder view to a table type view. Choose Inbox-Messages
2. Right-click a column heading, and then click Field Chooser.
3. From the list at the top of the Field Chooser, click to select the All item name fields.
4. Drag the Modified field to the table heading.
5. Verify that the duplicate items have a unique date from the original set of items. If it is unique, click the Modified heading so that the items are sorted by this field.
6. Click the first item in the set that you want to delete, scroll to the last item in the set that you want to delete, and then click the last item while you hold down the SHIFT key.
7. Press DELETE to permanently delete all selected items.

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
dim nbmail
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
							MonMail.move MonDossier.Folders("Temp")
			end if
		end if
		on error goto 0
		msgbox icpt & " emails moved to Inbox\Temp"

Open in new window

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now