Hallo!

Also für die Eingabe am besten eine kleine Userform basteln. Darauf 3 Textboxen in denen man die WErte eintragen kann. Und die Schaltflächen. Habe mal den Code nagepasst. Er durchläuft jetzt 3 Vorlagen und speichert dann die Nachrichten (theoretisch :-) , konnte es nicht testen)  Die Daten werden aus der Userform übernommen - ist aber erstmal auskommentiert. Aber beim Testen aufpassen, dadurch sind die Variablen unten im Code leer. Und die Werte die eingegeben werden, werden nicht auf Sinnhaftigkeit überprüft. Der Code würde dann wie folgt aussehen. VG

Sub mail_aus_vorlage()
Dim outlook As Object
Dim neueNachricht As Object
Dim betreff As String
Dim text As String
Dim pfad1 As String, pfad2 As String, pfad3 As String, speicherpfad As String
Dim i As Long
Dim datum, zeit, ort
Dim ekonto
Dim nachricht
Dim inbox
Dim zahler

pfad1 = "Pfad der ersten Vorlage mit Name auf .oft"
pfad2 = "Pfad der zweiten Vorlage mit Name auf .oft"
pfad3 = "Pfad der dritten Vorlage mit Name auf .oft"
speicherpfad = "Pfad zum Abspeichern endet mt \"

'userform1.Show
'datum = userform1.textbox1
'datum =
'zeit = userform1.textbox2
'ort = userform1.textbox3
'Unload userform1

Set outlook = CreateObject("Outlook.Application")
'hier den eigenen pfad reinpacken, dateiname endet mit .oft

For i = 1 To 3
    Set neueNachricht = outlook.CreateItemFromTemplate(pfad & i)
    neueNachricht.display True
    'alten Betreff und Text auslesen - ggf. zugriff erlauben
    betreff = neueNachricht.Subject
    text = neueNachricht.body
    'Betreff um Datum ergänzen
    betreff = Format(datum, "yyyymmdd") & betreff
    neueNachricht.Subject = betreff
    ' Text ändern und ersetzen
    text = Replace(text, "<DATUM>", datum)
    text = Replace(text, "<UHRZEIT>", zeit)
    text = Replace(text, "<ORT>", ort)
    neueNachricht.body = text
    Set neueNachricht = Nothing
Next i

'mails verschickt, jetzt speichern
zahler = 0
Set ekonto = outlook.GetNamespace("MAPI")
Set inbox = ekonto.GetDefaultFolder(6)  'der Posteingang

For Each nachricht In inbox.items   'alle Mails durchgehen
    If zahler < 4 Then  'um nur die ersten drei Treffer zu speichern
        If Left(nachricht.Subject, 8) = Format(datum, "yyyymmdd") Then  'wenn der Betreff damit beginnt
            nachricht.SaveAs speicherpfad & nachricht.Subject & ".msg"
            zahler = zahler + 1  'dadurch werden nur die ersten 3 Treffer gespeichert
        End If
    End If
Next nachricht
                
              
End Sub