M
mi6
Hello,
just in case you want all your contacts' e-mail address fields fixed (duplicates, empty fields, etc.), here's a macro which I wrote myself:
just in case you want all your contacts' e-mail address fields fixed (duplicates, empty fields, etc.), here's a macro which I wrote myself:
Code:
Sub Repair_E_Mail_Addresses()
Dim objApp As Outlook.Application
Dim objNS As NameSpace
Dim objSelection As Outlook.Selection
Dim objItem As ContactItem
Dim str() As String, yesno As String
Dim objcount, i As Integer
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objSelection = objApp.ActiveExplorer.Selection
MsgBox ("Repairing " & objSelection.count & " contacts.")
'the following "i = 0 to 2" loop is to ensure that both empty fields
'are removed by shifting address 2 and 3 up and, afterwards, all
'duplicate entries are removed
For i = 0 To 2
Select Case LCase(objItem.Email1Address)
Case ""
objItem.Email1Address = objItem.Email2Address
objItem.Email2Address = objItem.Email3Address
objItem.Email3Address = ""
Case LCase(objItem.Email2Address)
objItem.Email2Address = objItem.Email3Address
Case LCase(objItem.Email3Address)
objItem.Email3Address = ""
Case Else
End Select
Select Case LCase(objItem.Email2Address)
Case ""
objItem.Email2Address = objItem.Email3Address
objItem.Email3Address = ""
Case LCase(objItem.Email1Address)
objItem.Email2Address = ""
Case LCase(objItem.Email3Address)
objItem.Email3Address = ""
Case Else
End Select
Select Case LCase(objItem.Email3Address)
Case LCase(objItem.Email1Address)
objItem.Email3Address = ""
Case LCase(objItem.Email2Address)
objItem.Email3Address = ""
Case Else
End Select
Next i
objItem.Save
End Sub