Public Sub Send_Email()
Dim sTitle As String
sTitle = "Bestellung"
Dim sTemplate As String
Dim ws As Worksheet
Set ws = Sheets("_programm")
Dim app_Outlook As Outlook.Application
Set app_Outlook = New Outlook.Application
Dim objEmail As Outlook.MailItem
With objEmail
Dim sHTML As String
Dim varChar
For Each varChar In Sheets("_text").Shapes(1).TextFrame2.TextRange.Characters
Dim char_Text As String
char_Text = varChar.Text
char_Text = Replace(char_Text, vbCrLf, "<br>")
char_Text = Replace(char_Text, vbLf, "<br>")
Next
sHTML = sHTML & char_Text
Dim tblBestellliste As ListObject
Set tblBestellliste = ws.ListObjects("tblBestellliste")
Dim iRow As Integer
For iRow = 2 To tblBestellliste.ListRows.Count
Next
Dim sText As String
sText = sHTML
Dim iCol As Integer
For iCol = 1 To tblBestellliste.ListColumns.Count
Dim sPlaceholder As String
sPlaceholder = tblBestellliste.Range(1, iCol)
sPlaceholder = Trim(sPlaceholder)
Dim sValue As String
sValue = tblBestellliste.Range(iRow, iCol)
sValue = Trim(sValue)
If Not sPlaceholder Like "" Then
sText = Replace(sText, "[@" & sPlaceholder & "]", sValue, , , vbTextCompare)
End If
Next
Set objEmail = app_Outlook.CreateItem(olMailItem)
objEmail.To = "email@mail.com"
objEmail.Subject = sTitle
objEmail.HTMLBody = sText
objEmail.Display False
objEmail.Send
End With
End Sub