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: 24.297  | #150
◀ Vorheriges Beispiel Nächstes Beispiel ▶
OLKeeper OLKeeper
Der OLKeeper verhindert zuverlässig, dass Sie Microsoft Outlook unbeabsichtigt schließen und so etwa wichtige Emails verpassen würden.

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
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