Bulk Move Phone Numbers to a Different Phone Field

Willy shared this with us:

"I found your very interesting page on how to bulk edit "FileAS" info for Outlook contacts. I have a Palm Pre 2 and Microsoft Exchange sync. Due to a bug, phone numbers entered in "Other Phone" field in Outlook won't sync with the smartphone. I was seeking a way to mass edit my contacts to move "other phone" to "mobile phone" (when empty). I used your script and put the following lines in the part used for "FileAs":

If .OtherTelephoneNumber <> "" Then
If .MobileTelephoneNumber = "" Then
.MobileTelephoneNumber = .OtherTelephoneNumber
.OtherTelephoneNumber = ""
.Save
End If
End If

It worked like a charm. From 160+ contacts with "OtherPhone", I ended up with less than 10 where Mobile phone was not empty and I needed to store the phone number in another category (home or business or Notes as text). Your code saved my day. Thanks"

VBA Sample

Press Alt+F11 to open the VBA editor then copy and paste into ThisOutlookSession then run. Note that it works on the contacts in the default contacts folder.

I tested this code in Outlook 2010. It should work just fine in Outlook 2003 and Outlook 2007. (May trigger the Email security prompts in Outlook 2003.)

Public Sub MovePhoneNumber()
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objContact As Outlook.ContactItem
    Dim objItems As Outlook.Items
    Dim objContactsFolder As Outlook.MAPIFolder
    Dim obj As Object

    On Error Resume Next

    Set objOL = CreateObject("Outlook.Application")
    Set objNS = objOL.GetNamespace("MAPI")
    Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
    Set objItems = objContactsFolder.Items

    For Each obj In objItems
        'Test for contact and not distribution list
        If obj.Class = olContact Then
            Set objContact = obj

     With objContact

          If .OtherTelephoneNumber <> "" Then
            If .MobileTelephoneNumber = "" Then
                .MobileTelephoneNumber = .OtherTelephoneNumber
                .OtherTelephoneNumber = ""
            .Save
            End If
        End If

     End With
        End If

     Err.Clear
    Next

    Set objOL = Nothing
    Set objNS = Nothing
    Set obj = Nothing
    Set objContact = Nothing
    Set objItems = Nothing
    Set objContactsFolder = Nothing
End Sub

Related Posts:

1. Outlook includes fax numbers in the address book because they are vali

   Make the Address Book show only e-mail addresses, not fax numbers
2. 

   Check Contacts before moving them to Hotmail Contacts folder
3. If you have Contacts in the Contacts folder but they are not accessibl

   Imported Addresses are Missing from Address Book
4. 

   Bulk change Contact's FileAs format to match Outlook's default setting