According to the criteria "copy the filtered ranges" shall be pasted into an e-mail with the text stated in "strText" both as html. If the criteria is not fullfiled then the text stated in "strText2" is taken only and pasted into the e-mail.
The issue is that only the text in "strText" is copied into the E-Mail without the copied range. Secondly, in the "Else" line the code ".HTMLBody = strText2" wouldnt as it goes directly to the sheet.
(the "Function GetBoiler..." has been excluded due to simplicity)
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 = "[email protected]
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
The answer can be found here: https://www.rondebruin.nl/win/s1/outlook/bmail2.htm