Dim objApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim objAddrList As Outlook.AddressList
Dim objAddrEntries As Outlook.AddressEntry
Dim objAddrEntry As Outlook.AddressEntry
Dim blnExists As Boolean
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objAddrList = objNS.AddressLists("Personal Address Book")
Set objAddrEntries = objAddrList.AddressEntries
Set objAddrEntry = objAddrEntries.GetFirst
Do Until objAddrEntry Is Nothing
If objAddrEntry.DisplayType = olUser Then
If objAddrEntry.Name = "Joe Bloggs" Then
'Recipient already in address book
blnExists = True
Exit Do
End If
End If
Set objAddrEntry = objAddrEntries.GetNext
Loop
If Not blnExists Then
'Recipient not found, add it
Set objAddrEntry = objAddrEntries.Add( _
"User", "Joe Bloggs", "joe@nowhere.com"
End If
Set objAddrEntry = Nothing
Set objAddrEntries = Nothing
Set objAddrList = Nothing
Set objNS = Nothing
Set objApp = Nothing