title: VBA add signature to email that uses RangetoHTML (rng to Range) Function
body: <p>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.</p>
  
  <p>How do I get my signature back?</p>
  
  <p>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.</p>
  
  <pre><code>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 &amp; "; " &amp; 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" &amp; _
             vbNewLine &amp; "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 " &amp; Sheets("WEEKLY MATCHUPS").Range("A1") &amp; " - Thursday Reminder"
              .HTMLBody = "This is just a friendly reminder that your pick for tonight's Thursday Night Football game is due by kickoff @ " &amp; Format(Sheets("WEEKLY MATCHUPS").Range("M3"), "medium time") &amp; "&lt;BR&gt;" &amp; "&lt;BR&gt;" &amp; _
                           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") &amp; "\" &amp; Format(Now, "dd-mm-yy h-mm-ss") &amp; ".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
  </code></pre>