Option Explicit
Public Sub TestAddressBookFindReplace()
AddressBookFindReplace "Contacts", "@baz", "@foo"
End Sub
Public Sub AddressBookFindReplace(addressBookName As String, findText As String, replaceText As String, Optional compareMethod As VbCompareMethod = vbBinaryCompare)
Const lngStart_c As String = "1"
Const lngNotFound As Long = 0
Const lngCount_c As Long = -1
Dim ns As Outlook.NameSpace
Dim al As Outlook.AddressList
Dim ae As Outlook.AddressEntry
Dim strAddr As String
Set ns = Outlook.Session
Set al = ns.AddressLists(addressBookName)
For Each ae In al.AddressEntries
strAddr = vbNullString
strAddr = ae.Address
If InStrB(lngStart_c, strAddr, findText, compareMethod) <> lngNotFound Then
ae.Address = VBA.replace(strAddr, findText, replaceText, lngStart_c, lngCount_c, compareMethod)
ae.Update True, False
End If
Next
End Sub
|