VBA add signature to email that uses RangetoHTML (rng to Range) Function - vba

Question

I have the following code and it creates the email almost perfectly. What it doesn't do is maintain the default signature that is visible before it pastes the RangetoHTML results.
How do I get my signature back?
This is almost entirely drawn from Ron de Bruin's code samples and as I said, it all works very well except for the signature bit. This is an Outlook created signature, so I do have an htm copy of it locally. I did experiment and found that nothing, not even additional text or another string, will appear after the ".body = Selection.Paste". No, changing that to ".HTMLbody = Selection.Paste", does not make it work.
Sub Mail_Reminder_Thursday()
'Emailing Script for Thursday Reminder
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim rng As Range
Dim sendBCC As String
sendBCC = ""
Dim emailCell As Range
Dim Signature As String
With ActiveSheet
' Cycle through email addresses, from B3 to one before next blank cell in column
For Each emailCell In .Range("D2", .Range("D2").End(xlDown))
If .Cells(emailCell.Row, "C").Text = "YES" Then
sendBCC = sendBCC & "; " & emailCell.Text
End If
Next emailCell
End With
Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Sheets("WEEKLY MATCHUPS").Range("T1:Z18").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
OutMail.Display
On Error Resume Next
With OutMail
.BodyFormat = 2
.Display
.BCC = sendBCC
.Subject = "Week " & Sheets("WEEKLY MATCHUPS").Range("A1") & " - Thursday Reminder"
.HTMLBody = "This is just a friendly reminder that your pick for tonight's Thursday Night Football game is due by kickoff # " & Format(Sheets("WEEKLY MATCHUPS").Range("M3"), "medium time") & "<BR>" & "<BR>" & _
RangetoHTML(rng)
.Body = Selection.Paste
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to paste the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

Answer 1

The trick here is that Outlook only adds the Signature when you .Display the email, and only if you haven't already made changes to .HTMLBody:
Dim DefaultSignature As String
.Display
DefaultSignature = .HTMLBody
.HTMLBody = "This is just a friendly reminder that your pick for tonight's Thursday Night Football game is due by kickoff # " & Format(ThisWorkbook.Worksheets("WEEKLY MATCHUPS").Range("M3").Value, "medium time") & "<BR>" & "<BR>" & _
RangetoHTML(rng) & DefaultSignature