When you sync Outlook contacts with some smartphones (like Androids), phone numbers can't be dialed because they contain the country code. This VBA code removes the +1 prefix from Outlook phone numbers. If you need to remove 2-digit country codes, you'll need to edit the function.

The code checks to see if the contact is a contact or a distribution list. If it's a distribution list, it's skipped and the code moves on to the next item.

Note that when you sync, Outlook may reformat the number. Use a 4-digit or 5-digit area code (ie, 1234 or 99999) in Control Panel's Phone and Modem Options to prevent numbers from being formatted.

Remove the country code from phone numbers

To use, select a contacts folder then open the VBA editor (use Alt+F11). Right click on the Project name and choose Insert > Module. Paste the code into the module. Press F8 or the Run button to run the macro.

"Update Contact Area Codes" can be used to change either country codes or area codes of selected contacts.

This basis for this code was originally posted in the old Microsoft Newsgroups by Michal Bednarz of CodeTwo software and tweaked by Patrick. I tweaked it to use one function and check for (and skip over) distribution lists.

Sub FixPhoneFormat()

Dim oFolder As MAPIFolder
 Set oFolder = Application.ActiveExplorer.CurrentFolder

' Confirm it's a contacts folder by looking at the default form name
' to see if it begins with "ipm.contact". 
' This allows it to work on folders with custom forms
 If Left(UCase(oFolder.DefaultMessageClass), 11) <> "IPM.CONTACT" Then
 MsgBox "You need to select a Contacts folder", vbExclamation
 Exit Sub
 End If
 
Dim nCounter As Integer
 nCounter = 0
 
Dim oItem
 For Each oItem In oFolder.Items
 Dim oContact As ContactItem

' If the current item is a not a Contact Group process the phone numbers
' If it's a DL, the code moves on to the next item
 If TypeName(oItem) <> "DistListItem" Then

 Set oContact = oItem
 With oContact
 .AssistantTelephoneNumber = FixFormat(.AssistantTelephoneNumber)
 .Business2TelephoneNumber = FixFormat(.Business2TelephoneNumber)
 .BusinessFaxNumber = FixFormat(.BusinessFaxNumber)
 .BusinessTelephoneNumber = FixFormat(.BusinessTelephoneNumber)
 .CallbackTelephoneNumber = FixFormat(.CallbackTelephoneNumber)
 .CarTelephoneNumber = FixFormat(.CarTelephoneNumber)
 .CompanyMainTelephoneNumber = FixFormat(.CompanyMainTelephoneNumber)
 .Home2TelephoneNumber = FixFormat(.Home2TelephoneNumber)
 .HomeFaxNumber = FixFormat(.HomeFaxNumber)
 .HomeTelephoneNumber = FixFormat(.HomeTelephoneNumber)
 .ISDNNumber = FixFormat(.ISDNNumber)
 .MobileTelephoneNumber = FixFormat(.MobileTelephoneNumber)
 .OtherFaxNumber = FixFormat(.OtherFaxNumber)
 .OtherTelephoneNumber = FixFormat(.OtherTelephoneNumber)
 .PagerNumber = FixFormat(.PagerNumber)
 .PrimaryTelephoneNumber = FixFormat(.PrimaryTelephoneNumber)
 .RadioTelephoneNumber = FixFormat(.RadioTelephoneNumber)
 .TelexNumber = FixFormat(.TelexNumber)
 .TTYTDDTelephoneNumber = FixFormat(.TTYTDDTelephoneNumber)
 
.Save
 
nCounter = nCounter + 1
 End With
 End If
 Next
 
MsgBox nCounter & " contacts processed.", vbInformation
 
End Sub
 

Private Function FixFormat(strPhone As String) As String
 
strPhone = Trim(strPhone)
 FixFormat = strPhone
 If strPhone = "" Then Exit Function
 Dim prefix As String
 prefix = Left(strPhone, 1)
 
 ' Configured for US
 ' Enter the correct prefix here
 Do While (prefix = "+" Or prefix = "1")
 
 ' if the prefix is 2 digits, change to 4;
 ' if 3 digits, change to 5
 strPhone = Mid(strPhone, 3)
 prefix = Left(strPhone, 1)
 Loop
 
' After we clean up the country code, we remove non-numeric characters
' Can be tweaked to change formatting, ie: change 202.555.1212 to 202-555-1212

 strPhone = Replace(strPhone, "(", "")
 strPhone = Replace(strPhone, ")", "")
 strPhone = Replace(strPhone, ".", "")
 strPhone = Replace(strPhone, " ", "")
 strPhone = Replace(strPhone, "-", "")

FixFormat = strPhone
 
End Function
 

Add the Country code

My function above can be tweaked to change the country code by changing the last line of the function to this format (assuming +1 was the old country code and +44 is the new country code).

FixFormat = "+44" + strPhone

Add Prefix Function

Michal's original code sample added the country code to contacts, replicating the Check Phone Number dialog.

Private Function FixFormat(strPhone As String) As String

FixFormat= strPhone
strPhone = Trim(strPhone)

If strPhone = "" Then Exit Function
If Left(strPhone, 1) = "+" Then Exit Function
If Left(strPhone, 2) = "(+" Then Exit Function
If Left(strPhone, 2) = "00" Then Exit Function
If Left(strPhone, 3) = "(00" Then Exit Function
If Left(strPhone, 1) = "1" Then Exit Function
If Left(strPhone, 2) = "(1" Then Exit Function

FixFormat= "1" + strPhone

End Function

Change the function

You can change the function to alter phone numbers in any number of ways - if you need to add a number to dial out, change an area code, and more.

This sample checks for US number (+1) and exits the function if found, otherwise it adds 6 to the beginning of the number.

 
Private Function FixFormat(strPhone As String) As String
  
strPhone = Trim(strPhone)
If strPhone = "" Then Exit Function
  
If Left(strPhone, 2) = "+1" Then Exit Function
strPhone = "6" & strPhone
FixFormat = strPhone
End Function