Hi eventuell kann mir hier jemand mit dem Code helfen? Mein Macro scheint 1. nicht direkt zu starten wenn ich Outlook öffne obwohl ich es erlaube, und meine Wharheitsfrage tritt nicht ein. Ich habe hier zwei Faktoren einmal Eingang von einem Bestimmten Sender und das Postfach in dem ich die Emails Markieren möchte soll in cc gesetzt sein. ich habe einige mails im postfach die beide faktoren erfüllen sollten. Aber ich bekomme dennoch zurück, dass min. eine nicht eintritt beim Debug und ich bin überfragt, wieso. Für jede Hilfe bin ich dankbar.

Das ist der Code:

Private WithEvents PosteingangItems As Outlook.items

Private Sub Application_Startup()
    Set PosteingangItems = Session.GetDefaultFolder(olFolderInbox).items
End Sub

Sub SetupHandler()
    Set PosteingangItems = Session.GetDefaultFolder(olFolderInbox).items
    MsgBox "Handler aktiviert!"
End Sub

Private Sub PosteingangItems_ItemAdd(ByVal item As Object)
    If TypeOf item Is MailItem Then
        Dim mail As MailItem
        Set mail = item

        ' Prüfen ob "info@brewmarket.com" in CC ist und Mail von Sales '
        If InStr(LCase(mail.CC), "Info postfach") > 0 And _
           InStr(LCase(mail.SenderEmailAddress), "Sales postfach") > 0 Then

            Call AngebotsNachfassung(mail)
            MsgBox "Neue Mail eingegangen!"
        End If
    End If
End Sub

Sub AngebotsNachfassung(mail As MailItem)
    On Error Resume Next

    Dim followupDate As Date
    followupDate = NächsterWerktag(Date + 4)

    With mail
        .FlagRequest = "Follow-up"
        .FlagStatus = olFlagMarked
        .ReminderSet = True
        .ReminderTime = followupDate + TimeValue("09:00:00")
        .Categories = "AngebotErinnerung"
        .Save
    End With

    Dim recipients As Variant
    recipients = Array("meine mail") 'ist hier schon meine email, aber anomysiert
    ErstelleNachfassAufgabe "Nachfassung Angebot: " & mail.Subject, followupDate, recipients

    ' Debug.Print "Angebotsmail verarbeitet. Erinnerung für: " & followupDate '
    ' Debug.Print "FlagStatus: " & mail.FlagStatus '
    ' Debug.Print "ReminderSet: " & mail.ReminderSet '
    ' Debug.Print "ReminderTime: " & mail.ReminderTime '
End Sub

Function NächsterWerktag(datum As Date) As Date
    ' Gibt den nächsten Werktag zurück, falls datum auf Samstag oder Sonntag fällt '
    Select Case Weekday(datum, vbMonday)
        Case 6 ' Samstag
            NächsterWerktag = datum + 2
        Case 7 ' Sonntag
            NächsterWerktag = datum + 1
        Case Else
            NächsterWerktag = datum
    End Select
End Function
Sub ErstelleNachfassAufgabe(ByVal titel As String, ByVal faelligkeit As Date, ByVal recipients As Variant)
    On Error Resume Next

    Dim olApp As Outlook.Application
    Dim olTask As Outlook.TaskItem

    Set olApp = Outlook.Application
    Set olTask = olApp.CreateItem(olTaskItem)

    With olTask
        .Subject = titel
        .DueDate = faelligkeit
        .ReminderSet = True
        .ReminderTime = faelligkeit + TimeValue("09:00:00")
        .Importance = olImportanceHigh
        .Sensitivity = olNormal
        .Body = "Automatisch erstellte Nachfassaufgabe."
        
        ' Owner setzen, hier erster Empfänger (erscheint so in Aufgabenliste) '
        If UBound(recipients) >= 0 Then
            .Owner = recipients(0)
        End If

        .Save
    End With

    Debug.Print "Aufgabe erstellt: " & titel & " für " & recipients(0)
    
    MsgBox "ich bin am laufen!"

    Set olTask = Nothing
    Set olApp = Nothing
End Sub

Debug:
Sender (raw): "Sales Postfach" ? Bedingungen NICHT erfüllt Betreff: “ CC: Info | Postfach