Adress-/Visitenkartendarstellung korrigieren

In Outlook® 2007 gibt es offenbar einen Bug in der Darstellung der Adressdaten in der Adresskarten- bzw. Visitenkartenansicht. Bei einigen Kontakten ist die Reihenfolge der Postleitzahl und des Ortes vertauscht. Eine Systematik ist nicht zu erkennen und der Grund dafür bisher unbekannt.

Beheben lässt sich das Problem, in dem man eine Änderung in den Adressdaten vornimmt, diese wieder rückgängig macht und den Kontakt dann speichert. Der nachfolgende Code nimmt Ihnen diese Arbeit ab.

Alternativ können Sie auch die betreffenden Kontakte in eine Datei exportieren (z. B. "Kommagetrennte Werte (Windows)") und anschließend wieder importieren. Beachten Sie aber, dass dabei mit Datenverlust zu rechnen ist (siehe Wie übertrage ich meine Outlook-Daten in eine neue Installation?)

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden. Den Code bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor).

Ab Outlook® 2007
(der Code sollte auch ab 2000 funktionieren, das wurde jedoch nicht getestet, da es ältere Outlook®-Versionen nicht betrifft)

Option Explicit
 
Public Sub RefreshAddressField()
 
    '=====================================================================
    ' Erneuert die PLZ, um die richtige Darstellung in Visitenkarten zu
    ' erhalten (Fehler, der bei Outlook® 2007 auftritt - Ursache unbekannt)
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2009-10-15 Version 1.0.0
    ' 2009-10-18 Version 1.1.0
    '=====================================================================
 
    Dim objFolder As Object
    Dim objItems As Outlook.Items
    Dim objItem As Outlook.ContactItem
 
    Dim strZipBusiness As String
    Dim strZipHome As String
    Dim strZipOther As String
 
    Dim blnCleanUp As Boolean
 
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Leerzeilen aus Adresse entfernen (wenn gewünscht, dann auf "Wahr"
    ' setzen (blnCleanUp = True))?
    '---------------------------------------------------------------------
    blnCleanUp = False
 
    '---------------------------------------------------------------------
    ' Aktuellen Ordner referenzieren
    '---------------------------------------------------------------------
    Set objFolder = Outlook.ActiveExplorer.CurrentFolder
 
    '---------------------------------------------------------------------
    ' Kein Kontaktordner?
    '---------------------------------------------------------------------
    If InStr(LCase(objFolder.DefaultMessageClass), "ipm.contact") = 0 Then
        MsgBox "Das Wiederherstellen der Adressdarstellung funktioniert " & _
            "nur mit Kontakten.", vbCritical + vbOKOnly, "Kontakte aktualisieren"
        GoTo ExitProc
    End If
 
    '---------------------------------------------------------------------
    ' Alle Elemente des aktuellen Ordners referenzieren
    '---------------------------------------------------------------------
    Set objItems = objFolder.Items
 
    '---------------------------------------------------------------------
    ' Alle Elemente bearbeiten
    '---------------------------------------------------------------------
    For Each objItem In objItems
 
        With objItem
 
            '-------------------------------------------------------------
            ' Werte merken
            '-------------------------------------------------------------
            strZipBusiness = .BusinessAddressPostalCode
            strZipHome = .HomeAddressPostalCode
            strZipOther = .OtherAddressPostalCode
 
            '-------------------------------------------------------------
            ' Änderung vornehmen
            '-------------------------------------------------------------
            .BusinessAddressPostalCode = 1
            .HomeAddressPostalCode = 1
            .OtherAddressPostalCode = 1
 
            '-------------------------------------------------------------
            ' Änderung wieder rückgängig machen
            '-------------------------------------------------------------
            .BusinessAddressPostalCode = strZipBusiness
            .HomeAddressPostalCode = strZipHome
            .OtherAddressPostalCode = strZipOther
 
            '-------------------------------------------------------------
            ' Leerzeilen aus Adressfeldern entfernen?
            '-------------------------------------------------------------
            If blnCleanUp Then
                .BusinessAddress = Replace(.BusinessAddress, vbCrLf & vbCrLf, vbCrLf)
                .HomeAddress = Replace(.HomeAddress, vbCrLf & vbCrLf, vbCrLf)
                .OtherAddress = Replace(.OtherAddress, vbCrLf & vbCrLf, vbCrLf)
            End If
 
            '-------------------------------------------------------------
            ' Änderung speichern
            '-------------------------------------------------------------
            .Save
 
        End With
 
    Next
 
ExitProc:
    '---------------------------------------------------------------------
    ' Clean Up
    '---------------------------------------------------------------------
    Set objItem = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
 
End Sub