VBOffice

Adresse im To-Feld suchen und Regel ausführen

Outlook kann eine Regel ausführen, wenn Sie der einzige Empfänger einer Email sind. Dieses Makro führt eine Regel nur dann aus, wenn Sie der einzige Empfänger im To-Feld sind, unabhängig davon, wieviele weitere Empfänger es im CC-Feld gibt.

Zuletzt geändert: 24.07.2015 | Aufrufe: 15.456  | #150
◀ Vorheriges Beispiel Nächstes Beispiel ▶
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.

Dieses Makro führt eine Regel aus, wenn Sie der einzige Empfänger im To-Feld sind, unabhängig davon, wieviele weitere Empfänger es im CC-Feld gibt. Im Beispiel wird der Email in dem Fall eine bestimmte Kategorie zugewiesen und somit farblich gekennzeichnet.

Ersetzen Sie die Beispieladresse 'test_1@domain.com' durch Ihre eigene Adresse. Wenn Sie mehrere Adressen suchen möchten, dann kopieren Sie die ganze Zeile einfach entsprechend oft. Über die Variable AdrType können Sie steuern, ob Ihre Adressen im To- oder im CC-Feld gesucht werden sollen. Und ersetzen Sie die Kategorie 'vboffice' durch einen beliebigen anderen Namen.

Erstellen Sie eine neue Regel, wählen Sie als Aktion 'ein Skript ausführen' und wählen Sie 'ToAddressRule' aus.


tip  So fügen Sie Makros in Outlook ein
Public Sub ToAddressRule(Mail As Outlook.MailItem)
  Dim CheckTo As Boolean
  Dim CheckCC As Boolean
  Dim Recipients As Outlook.Recipients
  Dim R As Outlook.Recipient
  Dim Addresses As New VBA.Collection
  Dim Nok As Boolean
  Dim AdrType As Long
  Dim Category As String
  Dim Adr As String
  
  'Meine Emailadressen, die gesucht werden sollen
  Adr = "test_1@domain.com": Addresses.Add Adr, Adr
  
  'Meine Adressen im To-Feld suchen (olTo durch olCC ersetzen, wenn im
  'CC-Feld gesucht werden soll)
  AdrType = olTo
  
  'Diese Kategorie zuweisen, wenn ich der einzige in To bin
  Category = "vboffice"
  
  Set Recipients = Mail.Recipients
  For Each R In Recipients
    If R.Type = AdrType Then
      If ItemExists(Addresses, R.Address) = False Then
        Nok = True
        Exit For
      End If
    End If
  Next
  
  If Nok Then
    Mail.Categories = Category
    Mail.Save
  End If
End Sub

Private Function ItemExists(Addresses As VBA.Collection, Adr As String) As Boolean
  On Error Resume Next
  Debug.Print Addresses(Adr)
  ItemExists = (Err.Number = 0)
End Function
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.
email  Senden Sie eine Nachricht