Outlook Mailing Addresses

To fix a problem with a corrupted Outlook profile, I created a new profile which caused all my Contacts to be initialized from my Windows Live account.  Pretty much everything came in OK, but one of the annoying things is that the “default mailing address” isn’t set right.  For whatever reason, Outlook doesn’t just do the logical thing here and say, well, the mailing address is home if there’s only a home address, work if there’s only a work address and if there’s both, I don’t know.  For 80+% of my contacts, I have only a work or home address but not both, and this would work great.  But instead, Outlook requires you to identify which address is the mailing address.  I had done this manually in my old contacts, but apparently this isn’t one of the Outlook Contact fields that is saved up to Windows Live – so it existed only in the local Outlook file.  When I blew that away and created a new profile, all that was lost.

Why does this matter?  When you do a mail merge, the mailing address is what’s used.  Plus I have a favorite view that shows name, mailing address, email, home and work phone in a list.  It’s a handy way to look things up quickly.  For all my contacts, mailing address is blank.

After living with this for a bit, I pulled out my old “VBA for Microsoft Office 2000 Unleashed” (yup, it’s been a while… ) and wrote a little Outlook macro to do the right thing here:

 Sub FixUpContacts()

On Error GoTo ExitFunc

Set olns = Application.GetNamespace("MAPI")
Set MyFolder = olns.GetDefaultFolder(olFolderContacts)
' Set MyItems to the collection of items in the folder.
Set MyItems = MyFolder.Items
For Each SpecificItem In MyItems
    Dim itemChanged As Boolean
    itemChanged = False
    
    If SpecificItem.SelectedMailingAddress = olNone Then
        If SpecificItem.HomeAddress <> "" And SpecificItem.BusinessAddress = "" Then
            SpecificItem.SelectedMailingAddress = olHome
            itemChanged = True
        ElseIf SpecificItem.HomeAddress = "" And SpecificItem.BusinessAddress <> "" Then
            SpecificItem.SelectedMailingAddress = olBusiness
            itemChanged = True
        End If
        If itemChanged = True Then
            SpecificItem.Save
        End If
    End If
Next

ExitFunc:

End Sub