Das jetzige Skript führt zwar die Protokollierung aus und zeigt keine Fehlermeldung mehr an, jedoch funktioniert die automatische Verschickung der Mail nicht. Würde jemanden der Fehler auffallen?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ProtokollSheet As Worksheet
    Dim letzteZeile As Long
    Dim Benutzer As String
    Dim Aktion As String
    
    ' Überprüfen, ob die Änderungen in der Tabelle "Lager" stattfinden
    If Target.Worksheet.Name = "Lager" Then
        ' Definieren des Protokollblatts
        Set ProtokollSheet = ThisWorkbook.Sheets("Protokoll")
        
        ' Ermitteln der letzten Zeile im Protokollblatt
        letzteZeile = ProtokollSheet.Cells(ProtokollSheet.Rows.Count, 1).End(xlUp).Row + 1
        
        ' Benutzername erfassen
        Benutzer = Application.UserName
        
        ' Aktion erfassen
        If Target.Value = "" Then
            Aktion = "Gelöscht"
        Else
            Aktion = "Geändert: " & Target.Value
        End If
        
        ' Protokolldatum erfassen
        ProtokollSheet.Cells(letzteZeile, 1).Value = Benutzer
        
        ' Datum und Uhrzeit erfassen
        ProtokollSheet.Cells(letzteZeile, 2).Value = Now()
        
        ' Geänderte Zelle erfassen
        ProtokollSheet.Cells(letzteZeile, 3).Value = Target.Address
        
        ' Änderung erfassen
        ProtokollSheet.Cells(letzteZeile, 4).Value = Aktion
        
        ' Speichern der Arbeitsmappe
        ThisWorkbook.Save
    End If
    
    ' Bereich 1: E2:E9 - Bestand unter 20
    Dim BestandRange1 As Range
    Dim ProduktRange1 As Range
    Dim BestandCell1 As Range
    Dim ProduktCell1 As Range
    Dim BestandThreshold1 As Integer
    
    ' Bereich 2: E11:E51 - Bestand unter 1
    Dim BestandRange2 As Range
    Dim ProduktRange2 As Range
    Dim BestandCell2 As Range
    Dim ProduktCell2 As Range
    Dim BestandThreshold2 As Integer
    
    ' E-Mail Informationen
    Dim MailAdresse As String
    Dim Betreff As String
    Dim Nachricht As String
    
    ' Definieren Sie den Bereich 1: E2:E9 und C2:C9
    Set BestandRange1 = Range("E2:E9")
    Set ProduktRange1 = Range("C2:C9")
    BestandThreshold1 = 20 ' Schwellenwert für Bestand unter 20
    
    ' Definieren Sie den Bereich 2: E11:E51 und C11:C51
    Set BestandRange2 = Range("E11:E51")
    Set ProduktRange2 = Range("C11:C51")
    BestandThreshold2 = 1 ' Schwellenwert für Bestand unter 1
    
    ' E-Mail-Adresse des Empfängers
    MailAdresse = "E-Mail"
    
    ' Betreff für die E-Mail
    Betreff = "Bestandsbenachrichtigung"
    
    ' Überprüfen Sie nur die Änderungen in den Bestandsbereichen
    
    ' Bereich 1: E2:E9
    If Not Intersect(Target, BestandRange1) Is Nothing Then
        For Each BestandCell1 In Intersect(Target, BestandRange1)
            If BestandCell1.Value < BestandThreshold1 Then
                Set ProduktCell1 = ProduktRange1.Cells(BestandCell1.Row - ProduktRange1.Cells(1).Row + 1)
                Nachricht = "Der Bestand des Produkts " & ProduktCell1.Value & " beträgt " & BestandCell1.Value & "."
                SendEmail MailAdresse, Betreff, Nachricht
            End If
        Next BestandCell1
    End If
    
    ' Bereich 2: E11:E51
    If Not Intersect(Target, BestandRange2) Is Nothing Then
        For Each BestandCell2 In Intersect(Target, BestandRange2)
            If BestandCell2.Value < BestandThreshold2 Then
                Set ProduktCell2 = ProduktRange2.Cells(BestandCell2.Row - ProduktRange2.Cells(1).Row + 1)
                Nachricht = "Der Bestand des Produkts " & ProduktCell2.Value & " beträgt " & BestandCell2.Value & "."
                SendEmail MailAdresse, Betreff, Nachricht
            End If
        Next BestandCell2
    End If
End Sub

Sub SendEmail(ByVal MailAdresse As String, ByVal Betreff As String, ByVal Nachricht As String)
    Dim objOutlook As Object
    Dim objMail As Object
    
    ' Erstellen einer neuen E-Mail im Outlook
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    
    With objMail
        .To = MailAdresse
        .Subject = Betreff
        .Body = Nachricht
        .Send ' Versendet die E-Mail direkt
    End With
    
    ' Objekte freigeben
    Set objMail = Nothing
    Set objOutlook = Nothing
End Sub