根据“复制过滤范围”的标准，应将粘贴到电子邮件中的“ strText”中所述的文本都作为html。如果标准不完整，则仅使用“ strText2”中所述的文本并将其粘贴到电子邮件中。
问题在于，只有“ strText”中的文本被复制到电子邮件中，而没有复制的范围。其次，在“其他”行中，代码“ .HTMLBody = strText2”不会直接进入工作表。
（由于简单性，“ Function GetBoiler ...”已被排除）
Sub Mail_Klicken()
Dim olApp As Object
Dim datDatum As Date
Dim StrBody As String
Dim intZeile As Integer
Dim rng As Range
Dim strMailverteilerTo As String
Dim strMailverteilerCC As String
Dim strText As String
Dim strFilename As String
Dim loLetzte As Long
strMailverteilerTo = "dfgdfg@gmx.de
strText = "<span style='font-size:10.0pt;font-family:""Arial"",""sans-serif"";color:black'>Hello,<br><br> xxxx:<br><br>"
strText2 = "<span style='font-size:10.0pt;font-family:""Arial"",""sans-serif"";color:black'>hello,<br><br>this is the second text.<br><br>"
Application.DisplayAlerts = True
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.to = strMailverteilerTo
.Subject = "asdf checked"
strFilename = "Standard"
If Application.UserName = "wert" Then strFilename = "Signatur allg.1"
strText = strText & "" & GetBoiler(Environ("appdata") & "\Microsoft\Signatures\" & strFilename & ".htm")
With Worksheets("Auswertung")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("$A$7:$D$" & loLetzte).AutoFilter Field:=4, Criteria1:=">0"
If .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1). _
SpecialCells(xlCellTypeVisible).Copy
Else
'take only the "strText2"
End If
.AutoFilterMode = False
End With
.HTMLBody = strText
.Display
End With
Set olApp = Nothing
End Sub