VBA code to add Signature to bottom of email

[Patriot2879]

Hi, good morning, I have the code below, where an email is sent, but I would like to add a signature at the end of the email, please can you help me with this? the email will be sent from Outlook. Thank you again.

Sub SendHTML_And_Image_As_Body_UsingOutlook()

    Dim olApp As Object, NewMail As Object
    Dim ChartName As String
    Dim imgPath As String
    Dim LastRow As Long
 
    If ActiveWorkbook.MultiUserEditing Then
    ActiveWorkbook.ExclusiveAccess
End If
    Set olApp = CreateObject("Outlook.Application")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    tmpImageName = VBA.Environ$("temp") & "\tempo.jpg"
    
   LastRow = ThisWorkbook.Sheets("South").Range("K" & Rows.Count).End(xlUp).Row
   Set RangeToSend = ThisWorkbook.Sheets("South").Range("A5:K" & LastRow)
    
    RangeToSend.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
    
    Set sht = Sheets.Add
    sht.Shapes.AddChart
    sht.Shapes.Item(1).Select
    Set objChart = ActiveChart
    With objChart
        .ChartArea.Height = RangeToSend.Height
        .ChartArea.Width = RangeToSend.Width
        .ChartArea.Fill.Visible = msoFalse
        .ChartArea.Border.LineStyle = xlLineStyleNone
        .Paste
        .Export Filename:=tmpImageName, FilterName:="JPG"
    End With
    sht.Delete
    Set NewMail = olApp.CreateItem(0)
    
    With NewMail
        .Subject = ThisWorkbook.Sheets("South").Range("K1").Value & "- South Handover"
        .To = ThisWorkbook.Sheets("Email Links").Range("C2").Value
        .CC = ""
        
        .HTMLBody = "******>Hi All, <br/><br/>Please find todays report below:<P></P>" & _
        "<br/><img src=" & "'" & tmpImageName & "'/><br/><P>Regards,<br/>Saturday JM </P></body>"
        .Display
        
    End With
    MsgBox "Email Sent successfully"
err:
    Set olApp = Nothing
    Set NewMail = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
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"
    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
    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
    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=")
    TempWB.Close savechanges:=False
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

 

[Patriot2879]

Hi I forgot to advise that this Is also for different users, so there own signature will need to go on. hope you can help.