Hallo liebe VBA Gemeinde,

kurzer Hintergrund.
Wir nutzen im Outlook sowohl ein Persönliches als auch ein Abteilungspostfach,
im Abteilungspostfach werden die neuen E-Mails Manuell per Kategorie zugewiesen.
Hierbei habe ich das Problem, sofern ein Kollege mir eine E-Mail zuweist bekomme ich das nicht mit,
hierzu müsste ich alle 5 - 10 Minuten takt in das Postfach schauen, was Arbeitstechnisch nicht wirklich möglich ist besonders bei größeren Projekten wo man vertieft drin steckt.

Über die Regeln kann ich das leider nicht einstellen, dass nach der manuellen Zuweisung über die "Kategorien" eine Weiterleitung an meine Persönliche E-Mail Adresse gemacht wird(Hierbei ist es wichtig das die eig. Mail liegen bleibt), hierdurch möchte ich eine aktive Information bekommen.

Ich habe auch schon eig. ausführlich Rechachiert mit verschiedenen Schlagwörtern, aber leider keine fertig Lösung im Internet gefunden.

Falls jemand das Thema interessant findet und mir beim Code helfen kann wäre das echt nett,
über jegliche Tipps freue ich mich natürlich auch. :-)

Schonmal vielen Dank!

Folgenden Code habe ich im Internet gefunden:
Quelle: In der Suchmaschine folgendes eingeben: "Aktionen mit Kategorien auslösen"

Private WithEvents Explorer As Outlook.Explorer
Private WithEvents Mail As Outlook.MailItem
Private MoveToThisFolder As Outlook.MapiFolder

Friend Sub Application_Startup()
  On Error Resume Next
  Set Explorer = Application.ActiveExplorer
End Sub

Private Sub Explorer_SelectionChange()
  Dim obj As Object
  Dim Sel As Outlook.Selection

  Set Mail = Nothing
  Set Sel = Explorer.Selection

  If Sel.Count > 0 Then
    Set obj = Sel(1)
    If TypeOf obj Is Outlook.MailItem Then
      Set Mail = obj
    End If
  End If
End Sub

Private Sub Mail_PropertyChange(ByVal Name As String)
  Dim Ns As Outlook.NameSpace
  Dim SubfolderName As String
  Dim Inbox As Outlook.MAPIFolder
  Dim Subfolder As Outlook.MAPIFolder
  Dim i&
  Dim Cats As String
  Dim arrCats() As String
  Dim FindCategory As String

  'Anpassen: Tragen Sie hier den Namen der zu suchenden Kategorie ein
  FindCategory = " (Actionlist)"
  'Tragen Sie hier den Namen des Ordners ein
  SubfolderName = "test"

  Set Ns = Application.GetNamespace("MAPI")
  Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
  Set Subfolder = Inbox.Folders(SubfolderName)
  If Subfolder.EntryID = Mail.Parent.EntryID Then
    Exit Sub
  End If

  If Name = "Categories" Then
    Cats = LCase$(Mail.Categories)
    FindCategory = LCase$(FindCategory)
    If Len(Cats) = 0 Then Exit Sub
    Cats = Replace(Cats, ",", ";")
    arrCats = Split(Cats, ";")
    For i = 0 To UBound(arrCats)
      Cats = Trim$(arrCats(i))
      If Cats = FindCategory Then
        Set MoveToThisFolder = Subfolder
        EnableTimer 500, Me
        Exit For
      End If
    Next
  End If
End Sub

Friend Sub TimerEvent()
  DisableTimer
  If Mail Is Nothing Then Exit Sub
  If MoveToThisFolder Is Nothing Then Exit Sub
  Mail.Move MoveToThisFolder
  Set Mail = Nothing
  Set MoveToThisFolder = Nothing
End Sub