Correct address and/or vcard view

In Outlook® 2007 there is a bug with the view of addresses in vcards. The postalcode and the city can be mixed up. You can correct it manually by changing e. g. the postacl code, undo this and save the contact. Alternatively you can export the contacts and reimport them again. This may cause loss of data (e. g. user defined fields, contact pictures and some more). The following script will do the manual changing job automatically.

To use this example please read the important notes and have a look to the workshop Use VBA in Outlook®. Please insert this code into a new module (Insert -> Module in the VBA-Editor).

For Outlook® 2007 and Outlook® 2010
(this code should also work from 2000 and higher, but it was not tested because this is only a problem of 2007)

Option Explicit
 
Public Sub RefreshAddressField()
 
    '=====================================================================
    ' Refreshes the postal code to get the correct view of the address
    ' details in vcards. (Bug of Outlook® 2007)
    ' (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
 
    '---------------------------------------------------------------------
    ' Remove empty lines from addresses (if wanted set blnCleanUp = True)?
    '---------------------------------------------------------------------
    blnCleanUp = False
 
    '---------------------------------------------------------------------
    ' Set a reference to the current folder
    '---------------------------------------------------------------------
    Set objFolder = Outlook.ActiveExplorer.CurrentFolder
 
    '---------------------------------------------------------------------
    ' No contact folder?
    '---------------------------------------------------------------------
    If InStr(LCase(objFolder.DefaultMessageClass), "ipm.contact") = 0 Then
        MsgBox "Restoring the address view in vcards will only work with " & _
            "contact folders.", vbCritical + vbOKOnly, "Refresh contacts"
        GoTo ExitProc
    End If
 
    '---------------------------------------------------------------------
    ' Set a reference to all items of the current folder
    '---------------------------------------------------------------------
    Set objItems = objFolder.Items
 
    '---------------------------------------------------------------------
    ' Process all items
    '---------------------------------------------------------------------
    For Each objItem In objItems
 
        With objItem
 
            '-------------------------------------------------------------
            ' Save values
            '-------------------------------------------------------------
            strZipBusiness = .BusinessAddressPostalCode
            strZipHome = .HomeAddressPostalCode
            strZipOther = .OtherAddressPostalCode
 
            '-------------------------------------------------------------
            ' Make changes
            '-------------------------------------------------------------
            .BusinessAddressPostalCode = 1
            .HomeAddressPostalCode = 1
            .OtherAddressPostalCode = 1
 
            '-------------------------------------------------------------
            ' Undo changes
            '-------------------------------------------------------------
            .BusinessAddressPostalCode = strZipBusiness
            .HomeAddressPostalCode = strZipHome
            .OtherAddressPostalCode = strZipOther
 
            '-------------------------------------------------------------
            ' Leerzeilen in Adressfelder entfernen?
            '-------------------------------------------------------------
            If blnCleanUp Then
                .BusinessAddress = Replace(.BusinessAddress, vbCrLf & vbCrLf, vbCrLf)
                .HomeAddress = Replace(.HomeAddress, vbCrLf & vbCrLf, vbCrLf)
                .OtherAddress = Replace(.OtherAddress, vbCrLf & vbCrLf, vbCrLf)
            End If
 
            '-------------------------------------------------------------
            ' Save changes
            '-------------------------------------------------------------
            .Save
 
        End With
 
    Next
 
ExitProc:
    '---------------------------------------------------------------------
    ' Clean Up
    '---------------------------------------------------------------------
    Set objItem = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
 
End Sub