Sub DeleteAddressEntry_Click()
    On Error Resume Next
    Set MyNameSpace = Application.GetNameSpace("MAPI")
    Set MyAddressList = MyNameSpace.AddressLists("Personal Address Book")
    If MyAddressList Is Nothing Then
        MsgBox "Personal Address Book Unavailable!", vbExclamation
        Exit Sub
    End If
    Set MyEntries = MyAddressList.AddressEntries
    MsgBox "Adding a sample entry...", vbInformation
    Set MyEntry = MyEntries.Add("SAMPLE", "Sample Entry", "sampleentry")
    MyEntry.Update
    MyEntry.Details
    Set MyEntry = MyEntries.GetFirst
    Do While TypeName(MyEntry) <> "Nothing"
        If MyEntry.Type = "SAMPLE" Then
            MsgBox "Deleting " & MyEntry, vbCritical
            MyEntry.Delete
        Exit Sub
        End If
        Set MyEntry = MyEntries.GetNext
    Loop
    MsgBox "No sample entries found.", vbInformation
End Sub