Hallo! Kann es grad nicht testen aber hab glaube ich den Fehler gefunden. Meine Zuordnung an die Pfade war schlicht falsch. Asche auf mein Haupt. Sie wie ich es geschrieben habe ging es natürlich nicht. Hier mal geändert aber immer noch ungetestet (habe hier kein OL). Die Pfade rutschen jetzt in ein Array und dann klappt die Zuordnung mit i auch wiedern ( theoretisch :-) ). Mal bitte testen ab es jetzt klappt. 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
Dim pfad(3)
 
pfad(1) = "Pfad der ersten Vorlage mit Name auf .oft"
pfad(2) = "Pfad der zweiten Vorlage mit Name auf .oft"
pfad(3) = "Pfad der dritten Vorlage mit Name auf .oft"
speicherpfad = "Pfad zum Abspeichern endet mt \"
 
'userform1.Show
'datum = cdate(userform1.textbox1)
'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