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