Hallo liebe Community,

ich muss ein VBA Projekt erstellen. Es soll eine automatische Zahlungsbestätigung erstellt werden als Email. Der Vorlagetext liegt als Text in einem Excelblatt mit drei Platzhaltern "@Name", "@Zahlbetrag" und "@Bestellnummer".

Ich möchte, dass wenn sich Outlook öffnet, der Standardtext im Email Body zeigt und die Platzhalter entsprechend einer weiteren Excelliste ersetzt werden.

Das ersetzten durch den Platzhalter funktionert auch, jedoch wird der Standardtext dreimal erstellt und jeweils einmal der Platzhalter ausgefüllt. Am Ende steht der Standardtext dreimal in der Email, wobei jeweils nur einmal pro Text ein Platzhalter richtig replaced wird.

Private Sub Send_Email()
    
    Dim sTitle As String
        sTitle = Tabelle2.Range("B2")
    
    'Body Text holen
    Dim sTemplate As String
    sTemplate = Sheets("Email").Shapes(1).TextFrame2.TextRange.Text

     'Senden mit Outlook
    Dim app_Outlook As Outlook.Application
    Set app_Outlook = New Outlook.Application
   
    'Email einstellen
    Dim objEmail As Outlook.MailItem
      
    
'   -------------------------------------------------------------------------------------------
    Dim sEmail_Name As String
    Dim sEmail_Zahlbetrag As String
    Dim sEmail_Bestellnummer As String
    
     
    Dim iZeile As Integer
    For iZeile = 5 To 50
        If Cells(iZeile, 8) = "x" Then
            
            sEmail_Name = Cells(iZeile, 2)
        Dim sName As String
            sName = Replace(sTemplate, "[@Name]", sEmail_Name)
            
            sEmail_Zahlbetrag = Cells(iZeile, 7)
        Dim sZahlbetrag As String
            sZahlbetrag = Replace(sTemplate, "[@Zahlbetrag]", sEmail_Zahlbetrag)
            
            sEmail_Bestellnummer = Cells(iZeile, 1)
        Dim sBestellnummer As String
            sBestellnummer = Replace(sTemplate, "[@Bestellnummer]", sEmail_Bestellnummer)
   
   
    'Elemente Email und anzeigen
           
        Dim sEmail_Addresse As String
        sEmail_Addresse = Cells(iZeile, 4)
        

            Set objEmail = app_Outlook.CreateItem(olMailItem)
            objEmail.SentOnBehalfOfName = "fastanswer1.0@web.de"
            objEmail.To = sEmail_Addresse
            objEmail.Subject = sTitle

            objEmail.Body = sName & sZahlbetrag & sBestellnummer
            objEmail.Display
            
      
     End If
   Next
     

            
    
'--------------------------------------------------------------------------------------------------
    
    'Abschluss
    Set objEmail = Nothing
    Set app_Outlook = Nothing
    
    
    
    MsgBox "Zahlungsbestätigung wurde erfolgreich erstellt", vbInformation, "Don't work hard, Work smart!"
    
    
 End Sub

Private Sub Zahlungsbestätigungcmd_Click()

Send_Email

End Sub