Sub GetAContact()
Dim olApplication As New Outlook.Application
Dim olNameSpace As Namespace
Dim MAPIFlder As MAPIFolder
Dim olContact As ContactItem
Set olNameSpace = olApplication.GetNamespace("MAPI")
Set MAPIFlder = olNameSpace.Folders("Personal Folders").Folders("Contacts")
For Each olContact In MAPIFlder.Items
If olContact.LastName = "Dummy" Then
Debug.Print olContact.FullName, olContact.Email1Address, olContact.BusinessTelephoneNumber
End If
Next
Set olContact = Nothing: Set MAPIFlder = Nothing: Set olNameSpace = Nothing: Set olApplication = Nothing
End Sub