Dim mapiNamespace As Outlook.NameSpace
    Set mapiNamespace = Application.GetNamespace("MAPI")
    
    Dim contactsFolder As Outlook.MAPIFolder
    Set contactsFolder = mapiNamespace.GetDefaultFolder(olFolderContacts)

    Dim contact As ContactItem
    For Each contact In contactsFolder.Items
        If contact.LastName <> "" And contact.FirstName <> "" Then
            contact.FileAs = contact.LastName & ", " & contact.FirstName & " (" & contact.Email1Address & ")"
        End If
    Next