RSSWhen 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.
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.
To use replace FixFormat in each number line with AddPrefix. (Or rename this function FixFormat. ;))
.AssistantTelephoneNumber = AddPrefix(.AssistantTelephoneNumber)
Private Function AddPrefix(strPhone As String) As String AddPrefix = 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 AddPrefix = "1" + strPhone End Function
