Adding default signature to code

Question

I am using the code below from Ron De Bruin to add some text and a range from an excel spreadsheet to the body of an email. I have limited knowledge of vba. I would also like to add a default signature to the email. Any help on how to adjust this code to do that would be very much appreciated. Thank you very much.

  Sub BOemail()
'
' BOemail Macro
'

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Username = Environ("username")


Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Available"
    Range("A1").Select

Set rng = Nothing
' Only send the visible cells in the selection.

Set rng = Sheets("BOTable").Range("A1:D6").SpecialCells(xlCellTypeVisible)

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(0)


With OutMail
    .To = UserForm2.TextBox4.Text
    .CC = ""
    .BCC = ""
    .Subject = "Backorder"
    .HTMLBody = "Thank you for your order number" & " " & UserForm2.TextBox7.Value & "." & "<br><br>" & "Please see below as some of the items are currently out of stock.  At this time, we are planning to hold your order until we can ship it to you complete.  Please contact us if any of the items are available to ship and you want us to ship what we have now, and send the backordered items when they are available.<br><br>" & "We will keep you updated on your backorder." & RangetoHTML(rng)
    .Attachments.Add "C:\Users\" & Username & "\Dropbox\Ample Supply Information\Ample Supply Company Line Card.pdf"
    .Display
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

 Exit Sub

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub


Function RangetoHTML(rng As Range)
' By Ron de Bruin.
    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 past 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

When I had a similar problem I found that splitting the setup of the mail into two parts made the default signature appear in the prepared mail.

    Dim OutSig As String

    With OutMail
        .display
        OutSig = .HTMLBody           ' here the signature is included
    End With
    With OutMail
        .To = MailList
        .Subject = Subj
        .Importance = 2
        .HTMLBody = RangeToHTML(MailRng) & OutSig
        .display
'        .Send
    End With

As I recall, the .display command in the first section was also required. I turned off ScreenUpdating before running that code.

Following your request, I have implemented the above idea into your own code, making some corrections and improvements along the way. I couldn't test the code however and regret if it shouldn't work for you as is.

Option Explicit

Sub BOemail()
    ' 18 Dec 2017

    Dim Rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim UserName As String
    Dim OutSig As String
    Dim Txt As String

    UserName = Environ("username")
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    Range("C1").FormulaR1C1 = "Available"
'    Range("A1").Select

    On Error Resume Next            ' error if no cells a visible
    Set Rng = Sheets("BOTable").Range("A1:D6").SpecialCells(xlCellTypeVisible)
    If Err Then
        MsgBox "The selection is not a range or the sheet is protected. " & _
               vbNewLine & "Please correct and try again.", vbOKOnly
        Exit Sub
    End If
    On Error GoTo 0

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .display
        OutSig = .HTMLBody           ' here the signature is included
    End With

    Txt = "Thank you for your order number " & UserForm2.TextBox7.Value & "." & vbCr & _
          "Please see below as some of the items are currently out of stock.  " & _
          "At this time, we are planning to hold your order until we can ship" & _
          "it to you complete.  Please contact us if any of the items are " & _
          "available to ship and you want us to ship what we have now, and " & _
          "send the backordered items when they are available." & vbCr & _
          "We will keep you updated on your backorder."

    With OutMail
        .To = UserForm2.TextBox4.Text
    '    .CC = ""
    '    .BCC = ""
        .Subject = "Backorder"
        .HTMLBody = Txt & RangetoHTML(Rng) & OutSig
        .Attachments.Add "C:\Users\" & UserName & "\Dropbox\Ample Supply Information\" & _
                             "Ample Supply Company Line Card.pdf"
        .display
    End With

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

The valiant point is that when you first create the OutMail object and display it the default signature is included. So, the HTMLbody is written to the string OutSig which basically contains nothing but the signature. When you next change the HTMLbody the signature is lost but since it was preserved in the string OutSig you can append it again to the new HTMLbody which replaced the original one.