Outlook DisplayName will not delete

[GoodOmens]

A user here imported hundreds of Outlook contacts with an email address of "[No email address found]". I am trying to use VBA to delete the bad email addresses. I below is simple code which should delete the email address from an open contact (a test before running it against the entire Contacts folder). The problem is that the resulting contact has no email address but the email display name is always reset to the FullName during the Save. Does anyone know how I can force the display name to be blank without manually opening each contact and deleting it myself?

Thanks!

Sub sample()
Dim c As ContactItem

Set c = Application.ActiveInspector.CurrentItem
If c.Class = olcontact Then
If c.Email1Address = "[No email address found]" Then
c.Email1AddressType = Empty
c.Email1Address = Empty
c.Email1DisplayName = Empty
c.Save
End If
End If

Set c = Nothing

End Sub