Klammern aus Telefonnummer löschen

Telefonnummern automatisch während der Eingabe korrigieren

Manche Smartphones können eine Telefonnummer nicht wählen, wenn Klammern enthalten sind. Das automatische Einfügen der Klammern in Outlook könnten Sie verhindern, indem Sie kein Leerzeichen zwischen der Vorwahl und der Anschlußnummer einfügen. Das macht eine Nummer aber schwerer lesbar. Mit folgenden Funktionen können Sie die Nummern wie gewohnt mit Leerzeichen eingeben, und die Klammern werden dann automatisch gelöscht.

Über die Ereignisse NewInspector und PropertyChange wird erkannt, wenn in einem geöffneten Kontakt eine Telefonnummer eingeben wird. Diese wird dann gleich korrigiert.

  So fügen Sie Makros in Outlook ein

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

Ausgewählte Kontakte editieren

Über die Funktion RemoveBrackets können Sie nachträglich ausgewählte Kontakte bearbeiten. Der Aufruf geschieht manuell z.B. über ALT+F8. Fügen Sie den Code unterhalb der obigen Funktionen ein.

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