Outlook Kontakte email Anzeigename ändern

Die Spaltensortierung Name im Adressbuch wird durch das Kontakte Feld "Speichern unter" (1), der Email Anzeigenamen durch das Kontakte Feld "Anzeigen als" (2) gesteuert.

Der folgende VBA Code ändert das Standard Format

Vorname Name (email Adresse) zu
Name, Vorname (email Adresse)

relevante Objekt (=Kontakt) Eigenschaft :=
.Email1DisplayName = .LastNameAndFirstName 'Format Nachname, Vorname


--- SCHNIPP Code BEGINN ---

Public Sub ChangeEmailDisplayName()
 
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objContact As Outlook.ContactItem
    Dim objItems As Outlook.Items
    Dim objContactsFolder As Outlook.MAPIFolder
    Dim obj As Object
    Dim strFirstName As String
    Dim strLastName As String
    Dim strFileAs As String

    On Error Resume Next

    Set objOL = CreateObject("Outlook.Application")
    Set objNS = objOL.GetNamespace("MAPI")
    Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
    Set objItems = objContactsFolder.Items

    For Each obj In objItems
        'Test for contact and not distribution list
        If obj.Class = olContact Then
            Set objContact = obj

          With objContact
   
          If .Email1Address <>"" Then
            ' Uncomment the  strFileAs line for the desired format
            ' Add the email address to any string using
            ' the following code:
            ' & " (" & .Email1Address & ")"
               
             'Firstname Lastname (email address) format
             ' strFileAs = .FullName & " (" & .Email1Address & ")"
               
             'Lastname, Firstname format
              strFileAs = .LastNameAndFirstName
               
             'Company name (email address) format
             ' strFileAs = .CompanyName & " (" & .Email1Address & ")"
               
             'Company Firstname Lastname (email address) format
             'the display name will have a leading space if
             'the contact doesn't have a company name
             'strFileAs = .CompanyName & " " & .FullName & " (" & .Email1Address & ")"
               
             'File As format
             'Does not support Company (Fullname) format.
             'Only Company name is used in the display name
             'strFileAs = .FileAs
               
             .Email1DisplayName= strFileAs

             .Save
           End If
          End With
        End If

        Err.Clear
    Next

    Set objOL = Nothing
    Set objNS = Nothing
    Set obj = Nothing
    Set objContact = Nothing
    Set objItems = Nothing
    Set objContactsFolder = Nothing

End Sub

--- SCHNIPP Code ENDE ---

siehe auch Outlook Kontakte Speichern unter