VBOffice

Klammern aus Telefonnummer löschen

Outlook 2013 schließt die Ortsvorwahl automatisch in Klammern ein. Dieses Makro löscht die Klammern gleich wieder.

Zuletzt geändert: 10.03.2015 | Aufrufe: 25.096  | #139
◀ Vorheriges Beispiel Nächstes Beispiel ▶

Inhalt

ReplyAll ReplyAll
Mit diesem Addin für Outlook erhalten Sie in verschiedenen Situationen eine Warnung, bevor Sie auf eine Email versehentlich allen anderen Empfängern antworten.

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.


tip  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
Reporter Reporter
Mit dem Reporter erstellen Sie Berichte für Ihre Outlook Daten. Mit wenigen Klicks werden Werte aus Aufgaben, Terminen und dem Journal summiert.

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
SAM SAM
Legen Sie fest, mit welcher "Identität" Ihre Emails beim Empfänger erscheinen sollen. Mit SAM bestimmen Sie den Absender und Speicherort für Emails anhand von Regeln.
email  Senden Sie eine Nachricht