Sub FixPhoneFormat() Dim oItem Dim oContact As ContactItem Set oItem = Application.ActiveInspector.CurrentItem With oItem .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 End With 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, "-", "") strPhone = Left(strPhone, 3) & "." & Mid(strPhone, 4, 3) & "." & Right(strPhone, 4) FixFormat = strPhone End Function