Hilfe bei VBA mit Outlook gesucht

Private Sub Worksheet_Change(ByVal Target As Range)
Const Zeile1 = 4 'erste Zeile mit Werten
Const ZeileMeldung = 3 ' Zeile mit der Warnmeldung (z.B. "Drehzahl hoch")
Dim rng As Range, z As Range
Dim i As Integer
Dim Sp(1 To 15) As Integer
Dim GW(1 To 15) As Double
Dim z1 As Long
'Spalten Setzen
For i = 1 To 15
Sp(i) = i + 36 'Wert1 in Spalte 37 (AK) usw.
Next i
'Grenzwerte setzen:
GW(1) = 1: GW(2) = 2: GW(3) = 3: GW(4) = 4: GW(5) = 5: GW(6) = 6
GW(7) = 7: GW(8) = 8: GW(9) = 9: GW(10) = 10: GW(11) = 11: GW(12) = 12
GW(13) = 13: GW(14) = 14: GW(15) = 15
For i = 1 To 15 ' alle 15 Spalten prüfen:
Set rng = Intersect(Target, Range(Cells(Zeile1, Sp(i)), Cells(Rows.Count, Sp(i))))
If Not rng Is Nothing Then
For Each z In rng
If z.Value > GW(i) Then
'letzten 2 Minuten prüfen (alle 10 Sekunden ein Wert also 12 Werte):
z1 = Application.Max(z.Row - 12, Zeile1) '12 Zeilen hoch, höchstens bis [Zeile1] _
_
wg. Überschriften
If WorksheetFunction.Max(Range(Cells(z1, z.Column), z.Offset(-1, 0))) 

Der e-mail-text in einem Makro auf das er zugreift:

Sub sende_stoermeldung(mld As String)
Dim MyMessage As Object, MyOutApp As Object
'InitializeOutlook = True
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "me@provider.de"
.Subject = "automatische Störmeldung MBHKW L: " & mld & " " & Date & " - " & Time
'Hier wird eine normale Text Mail erstellt
.body = "Es ist eine Störung eingetreten" & vbCrLf & mld
'Hier wird die Mail nochmals angezeigt
.Display
.Save
SendKeys "%S"
End With
MyOutApp.Quit
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub

Mein Problem liegt darin, dass er die Mail zwar erzeugt, aber nur in den Ordner Entwürfe packt.
Habe ich einen Fehler in meinem Code?
(Ich habe die Mail von meinem Computer an meine eigene Adresse geschickt, da hat er mir es in den Entwürfe gepackt. Habe auch versucht es testweise an einen Kollegen zu schicken, aber da passiert gleich gar nichts)
christian