Remove Brackets from Call Number

Automatically Correct Telephone Number

Some smartphones cannot dial a telephone number if it contains brackets. You could prevent that Outlook adds brackets by omitting the space between the area code and the phone number. However, that would make the number more difficult to read. So, enter the numbers with spaces, and let the following code automatically remove the brackets for you.

The events NewInspector and PropertyChange recognize when you enter a number into an open contact item. The number then will be corrected automatically.

  How to add macros to Outlook

Private WithEvents Inspectors As Outlook.Inspectors
Private WithEvents Contact As Outlook.ContactItem
Private m_Busy As Boolean

Friend Sub Application_Startup()
  Set Inspectors = Application.Inspectors
End Sub

Private Sub Inspectors_NewInspector(ByVal Inspector As Inspector)
  If TypeOf Inspector.CurrentItem Is Outlook.ContactItem Then
    Set Contact = Inspector.CurrentItem
  End If
End Sub

Private Sub Contact_PropertyChange(ByVal Name As String)
  If m_Busy Then Exit Sub
  
  Select Case Name
  Case "AssistantTelephoneNumber"
    If InStr(Contact.AssistantTelephoneNumber, "(") Then
      Contact.AssistantTelephoneNumber = Replace(Contact.AssistantTelephoneNumber, "(", "")
      Contact.AssistantTelephoneNumber = Replace(Contact.AssistantTelephoneNumber, ")", "")
    End If
  Case "Business2TelephoneNumber"
    If InStr(Contact.Business2TelephoneNumber, "(") Then
      Contact.Business2TelephoneNumber = Replace(Contact.Business2TelephoneNumber, "(", "")
      Contact.Business2TelephoneNumber = Replace(Contact.Business2TelephoneNumber, ")", "")
    End If
  Case "BusinessFaxNumber"
    If InStr(Contact.BusinessFaxNumber, "(") Then
      Contact.BusinessFaxNumber = Replace(Contact.BusinessFaxNumber, "(", "")
      Contact.BusinessFaxNumber = Replace(Contact.BusinessFaxNumber, ")", "")
    End If
  Case "BusinessTelephoneNumber"
    If InStr(Contact.BusinessTelephoneNumber, "(") Then
      Contact.BusinessTelephoneNumber = Replace(Contact.BusinessTelephoneNumber, "(", "")
      Contact.BusinessTelephoneNumber = Replace(Contact.BusinessTelephoneNumber, ")", "")
    End If
  Case "CallbackTelephoneNumber"
    If InStr(Contact.CallbackTelephoneNumber, "(") Then
      Contact.CallbackTelephoneNumber = Replace(Contact.CallbackTelephoneNumber, "(", "")
      Contact.CallbackTelephoneNumber = Replace(Contact.CallbackTelephoneNumber, ")", "")
    End If
  Case "CarTelephoneNumber"
    If InStr(Contact.CarTelephoneNumber, "(") Then
      Contact.CarTelephoneNumber = Replace(Contact.CarTelephoneNumber, "(", "")
      Contact.CarTelephoneNumber = Replace(Contact.CarTelephoneNumber, ")", "")
    End If
  Case "CompanyMainTelephoneNumber"
    If InStr(Contact.CompanyMainTelephoneNumber, "(") Then
      Contact.CompanyMainTelephoneNumber = Replace(Contact.CompanyMainTelephoneNumber, "(", "")
      Contact.CompanyMainTelephoneNumber = Replace(Contact.CompanyMainTelephoneNumber, ")", "")
    End If
  Case "Home2TelephoneNumber"
    If InStr(Contact.Home2TelephoneNumber, "(") Then
      Contact.Home2TelephoneNumber = Replace(Contact.Home2TelephoneNumber, "(", "")
      Contact.Home2TelephoneNumber = Replace(Contact.Home2TelephoneNumber, ")", "")
    End If
  Case "HomeFaxNumber"
    If InStr(Contact.HomeFaxNumber, "(") Then
      Contact.HomeFaxNumber = Replace(Contact.HomeFaxNumber, "(", "")
      Contact.HomeFaxNumber = Replace(Contact.HomeFaxNumber, ")", "")
    End If
  Case "Home2TelephoneNumber"
    If InStr(Contact.Home2TelephoneNumber, "(") Then
      Contact.Home2TelephoneNumber = Replace(Contact.Home2TelephoneNumber, "(", "")
      Contact.Home2TelephoneNumber = Replace(Contact.Home2TelephoneNumber, ")", "")
    End If
  Case "HomeTelephoneNumber"
    If InStr(Contact.HomeTelephoneNumber, "(") Then
      Contact.HomeTelephoneNumber = Replace(Contact.HomeTelephoneNumber, "(", "")
      Contact.HomeTelephoneNumber = Replace(Contact.HomeTelephoneNumber, ")", "")
    End If
  Case "ISDNNumber"
    If InStr(Contact.ISDNNumber, "(") Then
      Contact.ISDNNumber = Replace(Contact.ISDNNumber, "(", "")
      Contact.ISDNNumber = Replace(Contact.ISDNNumber, ")", "")
    End If
  Case "MobileTelephoneNumber"
    If InStr(Contact.MobileTelephoneNumber, "(") Then
      Contact.MobileTelephoneNumber = Replace(Contact.MobileTelephoneNumber, "(", "")
      Contact.MobileTelephoneNumber = Replace(Contact.MobileTelephoneNumber, ")", "")
    End If
  Case "OtherFaxNumber"
    If InStr(Contact.OtherFaxNumber, "(") Then
      Contact.OtherFaxNumber = Replace(Contact.OtherFaxNumber, "(", "")
      Contact.OtherFaxNumber = Replace(Contact.OtherFaxNumber, ")", "")
    End If
  Case "OtherTelephoneNumber"
    If InStr(Contact.OtherTelephoneNumber, "(") Then
      Contact.OtherTelephoneNumber = Replace(Contact.OtherTelephoneNumber, "(", "")
      Contact.OtherTelephoneNumber = Replace(Contact.OtherTelephoneNumber, ")", "")
    End If
  Case "PagerNumber"
    If InStr(Contact.PagerNumber, "(") Then
      Contact.PagerNumber = Replace(Contact.PagerNumber, "(", "")
      Contact.PagerNumber = Replace(Contact.PagerNumber, ")", "")
    End If
  Case "PrimaryTelephoneNumber"
    If InStr(Contact.PrimaryTelephoneNumber, "(") Then
      Contact.PrimaryTelephoneNumber = Replace(Contact.PrimaryTelephoneNumber, "(", "")
      Contact.PrimaryTelephoneNumber = Replace(Contact.PrimaryTelephoneNumber, ")", "")
    End If
  Case "RadioTelephoneNumber"
    If InStr(Contact.RadioTelephoneNumber, "(") Then
      Contact.RadioTelephoneNumber = Replace(Contact.RadioTelephoneNumber, "(", "")
      Contact.RadioTelephoneNumber = Replace(Contact.RadioTelephoneNumber, ")", "")
    End If
  Case "TelexNumber"
    If InStr(Contact.TelexNumber, "(") Then
      Contact.TelexNumber = Replace(Contact.TelexNumber, "(", "")
      Contact.TelexNumber = Replace(Contact.TelexNumber, ")", "")
    End If
  End Select
End Sub

Edit Selected Contacts

Call the function RemoveBrackets if you want to edit selected contact items subsequently. Do so, for instance, by pressing ALT+F8.

Public Sub RemoveBrackets()
  On Error GoTo ERR_HANDLER
  Dim c As VBA.Collection
  Dim obj As Object
  Dim Ct As Outlook.ContactItem
  Dim IsInspector As Boolean
  
  m_Busy = True
  Set c = GetCurrentItems(IsInspector)
  For Each obj In c
    If TypeOf obj Is Outlook.ContactItem Then
      Set Ct = obj
      With Ct
        If InStr(.AssistantTelephoneNumber, "(") Then
          .AssistantTelephoneNumber = Replace(.AssistantTelephoneNumber, "(", "")
          .AssistantTelephoneNumber = Replace(.AssistantTelephoneNumber, ")", "")
        End If
        If InStr(.Business2TelephoneNumber, "(") Then
          .Business2TelephoneNumber = Replace(.Business2TelephoneNumber, "(", "")
          .Business2TelephoneNumber = Replace(.Business2TelephoneNumber, ")", "")
        End If
        If InStr(.BusinessFaxNumber, "(") Then
          .BusinessFaxNumber = Replace(.BusinessFaxNumber, "(", "")
          .BusinessFaxNumber = Replace(.BusinessFaxNumber, ")", "")
        End If
        If InStr(.BusinessTelephoneNumber, "(") Then
          .BusinessTelephoneNumber = Replace(.BusinessTelephoneNumber, "(", "")
          .BusinessTelephoneNumber = Replace(.BusinessTelephoneNumber, ")", "")
        End If
        If InStr(.CallbackTelephoneNumber, "(") Then
          .CallbackTelephoneNumber = Replace(.CallbackTelephoneNumber, "(", "")
          .CallbackTelephoneNumber = Replace(.CallbackTelephoneNumber, ")", "")
        End If
        If InStr(.CarTelephoneNumber, "(") Then
          .CarTelephoneNumber = Replace(.CarTelephoneNumber, "(", "")
          .CarTelephoneNumber = Replace(.CarTelephoneNumber, ")", "")
        End If
        If InStr(.CompanyMainTelephoneNumber, "(") Then
          .CompanyMainTelephoneNumber = Replace(.CompanyMainTelephoneNumber, "(", "")
          .CompanyMainTelephoneNumber = Replace(.CompanyMainTelephoneNumber, ")", "")
        End If
        If InStr(.Home2TelephoneNumber, "(") Then
          .Home2TelephoneNumber = Replace(.Home2TelephoneNumber, "(", "")
          .Home2TelephoneNumber = Replace(.Home2TelephoneNumber, ")", "")
        End If
        If InStr(.HomeFaxNumber, "(") Then
          .HomeFaxNumber = Replace(.HomeFaxNumber, "(", "")
          .HomeFaxNumber = Replace(.HomeFaxNumber, ")", "")
        End If
        If InStr(.Home2TelephoneNumber, "(") Then
          .Home2TelephoneNumber = Replace(.Home2TelephoneNumber, "(", "")
          .Home2TelephoneNumber = Replace(.Home2TelephoneNumber, ")", "")
        End If
        If InStr(.HomeTelephoneNumber, "(") Then
          .HomeTelephoneNumber = Replace(.HomeTelephoneNumber, "(", "")
          .HomeTelephoneNumber = Replace(.HomeTelephoneNumber, ")", "")
        End If
        If InStr(.ISDNNumber, "(") Then
          .ISDNNumber = Replace(.ISDNNumber, "(", "")
          .ISDNNumber = Replace(.ISDNNumber, ")", "")
        End If
        If InStr(.MobileTelephoneNumber, "(") Then
          .MobileTelephoneNumber = Replace(.MobileTelephoneNumber, "(", "")
          .MobileTelephoneNumber = Replace(.MobileTelephoneNumber, ")", "")
        End If
        If InStr(.OtherFaxNumber, "(") Then
          .OtherFaxNumber = Replace(.OtherFaxNumber, "(", "")
          .OtherFaxNumber = Replace(.OtherFaxNumber, ")", "")
        End If
        If InStr(.OtherTelephoneNumber, "(") Then
          .OtherTelephoneNumber = Replace(.OtherTelephoneNumber, "(", "")
          .OtherTelephoneNumber = Replace(.OtherTelephoneNumber, ")", "")
        End If
        If InStr(.PagerNumber, "(") Then
          .PagerNumber = Replace(.PagerNumber, "(", "")
          .PagerNumber = Replace(.PagerNumber, ")", "")
        End If
        If InStr(.PrimaryTelephoneNumber, "(") Then
          .PrimaryTelephoneNumber = Replace(.PrimaryTelephoneNumber, "(", "")
          .PrimaryTelephoneNumber = Replace(.PrimaryTelephoneNumber, ")", "")
        End If
        If InStr(.RadioTelephoneNumber, "(") Then
          .RadioTelephoneNumber = Replace(.RadioTelephoneNumber, "(", "")
          .RadioTelephoneNumber = Replace(.RadioTelephoneNumber, ")", "")
        End If
        If InStr(.TelexNumber, "(") Then
          .TelexNumber = Replace(.TelexNumber, "(", "")
          .TelexNumber = Replace(.TelexNumber, ")", "")
        End If
      End With
      If IsInspector = False Then
        If Ct.Saved = False Then
          Ct.Save
          DoEvents
        End If
      End If
    End If
  Next
ERR_HANDLER:
  m_Busy = False
End Sub

Private Function GetCurrentItems(Optional IsInspector As Boolean) As VBA.Collection
  Dim c As VBA.Collection
  Dim Sel As Outlook.Selection
  Dim obj As Object
  Dim i&
  
  Set c = New VBA.Collection
  
  If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    IsInspector = True
    c.Add Application.ActiveInspector.CurrentItem
  Else
    IsInspector = False
    Set Sel = Application.ActiveExplorer.Selection
    If Not Sel Is Nothing Then
      For i = 1 To Sel.count
        c.Add Sel(i)
      Next
    End If
  End If
  Set GetCurrentItems = c
End Function