FixContact

Früher unter dem Namen "Mr2Herr" korrigiert dieses Skript eine falsche Anrede in den Kontakten und den "Speichern unter"-Namen.. Gerade bei der Migration von anderen Mailsystem oder beim Wechsel der Sprache passiert es immer wieder, dass zwar Vorname und Nachname korrekt übernommen werden aber die Anrede in der falschen Sprache erscheint. Ein Kandidat ist dazu die Notes Transporter Suite, welche in Notes enthaltene deutsche Anreden bei der Migration in Outlook in die Englische Form überführt. Hier ein Beispiel von konvertierten Musterkontakten.

Im gleichen Zuge passiert es auch, dass das Feld "Speichern unter" (Feld "FileAs") in der Schreibweise "Vorname Nachname" gefüllt wird. was natürlich ebenso wenig passend ist. In Deutschland sortieren wir die Anwender in der Regel nach dem Schema "Nachname, Vorname". Die "falsche" Schreibweise bringt auch die Sortierung im Adressbuch durcheinander.

Aufgabenstellung

Da das Problem nicht nur ein Postfach betrifft, sondern in der Regel viele Benutzer, arbeitet FixContact als VBScript, welches per CDO beliebige Postfächer öffnen und die Inhalte im Kontaktordner entsprechend anpassen kann. Es holt sich den Inhalt der Felder Anrede, Vorname, Nachname und Firma, fixt die Anrede und generiert den angezeigten Namen.

Feld CDO-Konstante hex

Firma

CdoPR_COMPANY_NAME

&H3A16001F

Vorname

CdoPR_GIVEN_NAME

&H3A06001F

Nachname

CdoPR_SURNAME

&H3A11001E

Titel

CdoPR_TITLE

&H3A17001F

Anzeigename

CdoPR_DISPLAY_NAME

&H3001001F

Anrede

PR_DISPLAY_NAME_PREFIX

 

Initialen

CdoPR_INITIALS

&H3A0A001E

Speichern unter

CdoPR_FileAs

&H81C2001E

Ein Teil ist die Umsetzung der Anrede (PR_DISPLAY_NAME_PREFIX).

Anrede ALT Anrede Neu

Ms.

Frau

Mrs.

Frau (das Fräulein ist heute wohl nicht mehr angesagt)

Mr.

Herr

Miss

Frau

*

unverändert

Das Skript sucht einfach nach diesem Feld und schreibt es entsprechend um.

Der zweite Teil ist natürlich die Korrektur des "Speicher unter" bzw. des Anzeigedatums. Outlook bietet hier mehrere Optionen an, den Anzeigenamen eines Kontakts zu erstellen.

Das Skript holt sich einfach den Nachnamen, Vornamen und die Firma, baut daraus das Feld für "FileAs" zusammen und schreibt es zurück. Nach meiner Erfahrung bei Kunden ist das meist gewünschte Format ein "%Nachname%, %Vorname% (%Firma%)", welches das Skript auch aufbaut. Voraussetzung ist dabei aber mindestens, dass die Felder Vorname, Nachname, Firma auch gefüllt sind, ansonsten werden diese weg gelassen. Ergebnisse wie "Nachname, Vorname ()" sollten ebenso wenig auftreten wie ", Vorname ()" etc.

Aufruf und Anwendung

Als VBScript wird das Skript natürlich wieder per CSCRIPT gestartet, damit die Bildschirmausgaben auf der Console ausgegeben werden. Weiterhin müssen Sie wieder mit entsprechend privilegierten Rechten arbeiten (Siehe auch Mailboxrechte) und auf dem System muss die CDO (Siehe MAPI/CDO) installiert sein. Als Übergabe erwartet das Skript die Liste der Benutzer (Alias oder Mailadresse) per STDIN oder als Parameter.

echo User1 | cscript fixcontact.vbs /server:srv01 /mode:MOD /reportcsv c:\fixcontact.csv

Natürlich können Sie dem Skript auch eine Liste von Postfächern (Alias oder SMTP-Adresse) über STDIN zusenden oder über einen FOR-Schleife das Skript mit jedem Postfach einzeln aufrufen und so pro Postfach eine eigene Reportdatei anlegen lassen. 

Die gemachten Veränderungen werden auch hier in eine CSV-Datei protokolliert.

VBA-Version

Wer nur die Kontakte in einem Ordner bearbeiten will, kann die hier veröffentlichte VBA-Version verwenden.

Sub FixContact()
    Dim objfolder As MAPIFolder
    Set objfolder = Outlook.GetNamespace("MAPI").PickFolder
    
    Const strmode = "READ"     '
    ' const strmode = "MOD"      ' aktivieren zum ändern
    
    Dim Item As Object
    Dim colContacts As items
    Dim objcontact As contactitem
    Dim count As Integer
    Dim subject As String
    
    Set colContacts = objfolder.items
    Set Item = colContacts.GetFirst
    
    Dim strNamePrefix, strNamePrefixNeu As String
    
    Do While Not Item Is Nothing
        
        If Item.MessageClass <> "IPM.Contact" Then
            Debug.Print "Skip NonContact:" & Item.subject
        Else
            Set objcontact = Item
            Debug.Print "  ProcessContact Subject:" & objcontact.subject
            strNamePrefix = objcontact.Title  'anrede
            Select Case LCase(strNamePrefix)
                Case "mr.": strNamePrefixNeu = "Herr"
                Case "ms.": strNamePrefixNeu = "Frau"
                Case "mrs.": strNamePrefixNeu = "Frau"
                Case "miss.": strNamePrefixNeu = "Frau"
                Case Else: strNamePrefixNeu = strNamePrefix
            End Select
            If strNamePrefixNeu <> strNamePrefix Then
                Debug.Print "      Found " & strNamePrefix & " Replace with " & strNamePrefixNeu
                If strmode = "MOD" Then
                    objcontact.Title = strNamePrefixNeu
                    objcontact.Save
                    Debug.Print "     Anrede:WRITE Modifications:" & strNamePrefixNeu
                Else
                    Debug.Print "     Anrede:write Modifications:" & strNamePrefixNeu
                End If
            Else
                Debug.Print "     Anrede:Skip Entry:" & strNamePrefixNeu
            End If

            Dim newFileAs As String: newFileAs = ""
            
            If objcontact.LastName <> "" Then
                newFileAs = newFileAs & objcontact.LastName
                Debug.Print "  FileAs=" & newFileAs
            End If

            If objcontact.FirstName <> "" Then
                If newFileAs <> "" Then
                    newFileAs = newFileAs & ", " & objcontact.FirstName
                End If
                Debug.Print "  FileAs=" & newFileAs
            End If

            If objcontact.CompanyName <> "" Then
                If newFileAs <> "" Then
                    newFileAs = newFileAs & " (" & objcontact.CompanyName & ")"
                End If
                Debug.Print "  FileAs=" & newFileAs
            End If
            
            If objcontact.FileAs = newFileAs Then
                Debug.Print "     FileAs not modified"
            Else
                If strmode = "MOD" Then
                    objcontact.FileAs = newFileAs
                    objcontact.Save
                    Debug.Print "  FileAs MOD"
                Else
                    Debug.Print "  FileAs READ"
                End If
            End If
        End If
        Set Item = colContacts.GetNext
    Loop
    
    

End Sub

Hinweise zum umgang mit VBA-Dateien finden Sie auf Outlook VBA.

Weitere Links