For the programmatically inclined. Here's some VBA code i found some while back on the net and i edited it, added some comments ...etc. I like this method the best, as it is non-destructive and upto you what you do with it. I have used it successfully and i love it! Also include is some other code that you can try out... and using the template you can do any of your own operations if you know VBA...!
How to use?
1) Copy Code below
2) Open outlook, Tools>Macro>Visual Basic Editor (Alt + F11)
3) Insert new module
or * Alternatively you can import the attached file "MarkTools.bas" and skip to step 7
4) Paste Code
5) Save
6) Close VBE
7) Tools>Macro>Run Macro (Alt + F8)
Choose "MarkDuplicateContacts"
9) Now goto your contacts folder
10) Add the column/field "FTP Site"
11) Group by that column
12) All FTP Sites that say "DELETE.ME.I.AM.A.DUPE" can be safely deleted/moved to another folder
13) You are done!
Attribute VB_Name = "MarkTools"
Public Sub MarkDuplicateContacts()
Dim oldcontact As ContactItem, newcontact As ContactItem, j As Integer
Dim lCount As Long
Set mynamespace = GetNamespace("MAPI")
Set myfolder = mynamespace.GetDefaultFolder(olFolderContacts)
Set myitems = myfolder.Items
'Sort Contacts
myitems.Sort "[File As]", olDescending
totalcount = myitems.Count
j = 1
'Find first valid contact
While ((j < totalcount) And (myitems(j).Class <> olContact))
j = j + 1
Wend
Set oldcontact = myitems(j)
'Process each contact from there on
'This loop compares only contacts before and after the current one
'since the list is sorted, this should work correctly as contacts
'with the same name WILL be next to each other
'This is a standard linear algorithm with a performance of O(N) (in Big O notation)
'(or so i think :))
For i = j + 1 To totalcount
If (myitems(i).Class = olContact) Then
Set newcontact = myitems(i)
'if((newcontact.lastmodificationtime = oldcontact.lastmodificationtime) and
If ((newcontact.LastNameAndFirstName = oldcontact.LastNameAndFirstName) And _
(newcontact.FileAs = oldcontact.FileAs) And _
(newcontact.PagerNumber = oldcontact.PagerNumber) And _
(newcontact.HomeTelephoneNumber = oldcontact.HomeTelephoneNumber) And _
(newcontact.BusinessTelephoneNumber = oldcontact.BusinessTelephoneNumber) And _
(newcontact.BusinessAddress = oldcontact.BusinessAddress) And _
(newcontact.Email1Address = oldcontact.Email1Address) And _
(newcontact.HomeAddress = oldcontact.HomeAddress) And _
(newcontact.CompanyName = oldcontact.CompanyName)) Then
'use FTPSite as a flag to mark duplicates
newcontact.FTPSite = "DELETE.ME.I.AM.A.DUPE"
newcontact.Save
lCount = lCount + 1
End If
Set oldcontact = newcontact
End If
Next i
MsgBox lCount & " Duplicate contacts found."
End Sub
Public Sub MarkBlankNumberContacts()
Dim oldcontact As ContactItem, newcontact As ContactItem, j As Integer
Dim lCount As Long
Set mynamespace = GetNamespace("MAPI")
Set myfolder = mynamespace.GetDefaultFolder(olFolderContacts)
Set myitems = myfolder.Items
'Sort Contacts
myitems.Sort "[File As]", olDescending
totalcount = myitems.Count
j = 1
l = 0
'Find first valid contact
While ((j < totalcount) And (myitems(j).Class <> olContact))
j = j + 1
Wend
'Process each contact from there on
'Check if ALL the possible phone number fields are blank...
'IF and only IF all are blank then can we mark the contact
For i = j + 1 To totalcount
If (myitems(i).Class = olContact) Then
Set newcontact = myitems(i)
If ((newcontact.AssistantTelephoneNumber = vbNullString) And _
(newcontact.BusinessFaxNumber = vbNullString) And _
(newcontact.BusinessTelephoneNumber = vbNullString) And _
(newcontact.Business2TelephoneNumber = vbNullString) And _
(newcontact.CarTelephoneNumber = vbNullString) And _
(newcontact.CompanyMainTelephoneNumber = vbNullString) And _
(newcontact.HomeFaxNumber = vbNullString) And _
(newcontact.HomeTelephoneNumber = vbNullString) And _
(newcontact.Home2TelephoneNumber = vbNullString) And _
(newcontact.MobileTelephoneNumber = vbNullString) And _
(newcontact.OtherFaxNumber = vbNullString) And _
(newcontact.OtherTelephoneNumber = vbNullString) And _
(newcontact.PrimaryTelephoneNumber = vbNullString) And _
(newcontact.RadioTelephoneNumber = vbNullString) And _
(newcontact.PagerNumber = vbNullString)) Then
'use FTPSite as a flag to mark Deletion
newcontact.FTPSite = "DELETE.ME.NO.NUMBERS"
newcontact.Save
lCount = lCount + 1
End If
End If
Next i
MsgBox lCount & " Contacts with no numbers found."
End Sub
Sub DisplayViewDef()
'Displays the XML definition of a View object
Dim olApp As Outlook.Application
Dim objName As Outlook.NameSpace
Dim objViews As Outlook.Views
Dim objView As Outlook.View
Set olApp = New Outlook.Application
Set objName = olApp.GetNamespace("MAPI")
Set objViews = objName.GetDefaultFolder(olFolderInbox).Views
'Return a view called Table View if it already exists, else create one
Set objView = objViews.Item("Table View")
If objView Is Nothing Then
Set objView = objViews.Add("Table View", olTableView, olViewSaveOptionAllFoldersOfType)
End If
MsgBox olApp.ActiveExplorer.CurrentView.XML
MsgBox objView.XML
End Sub
