Email Signature image appearing on 1st email sent, but not on others

Using this code, I'm able to extract the default signature, send an email using the sheet contents that I'm on:

Function RangetoHTML(rng As Range)
    ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010, and Office 365.
    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 workbook to receive the data.
       rng.Copy
       Set TempWB = Workbooks.Add(1)
       With TempWB.Sheets(1)
           .Cells(1).PasteSpecial Paste:=8
           .Cells(1).PasteSpecial xlPasteAll
           .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 an .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 the RangetoHTML subroutine.
    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.
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
Sub RegionMailer()
    ' Documentations for this macro is on the README.md file attached in this workbook.

    ' For debugging, comment out .send and uncomment .display
    ' CC to uncomment on publish

    ' Get email addresses
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olAL As Outlook.AddressList
    Dim olEntry As Outlook.AddressEntry
    Dim olMember As Outlook.AddressEntry
    Dim lMemberCount As Long
    Dim objMail As Outlook.MailItem

    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olAL = olNS.AddressLists("Global Address List")

    Set objMail = olApp.CreateItem(olMailItem)

    ' enter the list name
    Set olEntry = olAL.AddressEntries("ABC")

    ' get count of dist list members
    lMemberCount = olEntry.Members.Count

    ' loop through dist list and extract members
    Dim p As Long
    Dim sn As Long
    Dim rn As Range
    Dim firstName() As String
    Dim dtime As Date
    Dim StrBody As String
    Dim StrBody2 As String

    dtime = Now
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    ReDim EmailList(1 To lMemberCount, 1 To 3) As String
    For p = 1 To lMemberCount
        Set olMember = olEntry.Members.Item(p)
        EmailList(p, 1) = olMember.Name 'LN,FN
        EmailList(p, 2) = olMember.GetExchangeUser.PrimarySmtpAddress 'Email
        EmailList(p, 3) = olMember.GetExchangeUser.OfficeLocation ' Office Location e.g. ABC - 123 - DoReMi
    Next p

    With objMail
        .Display
        Signature = .HTMLBody
    End With

    For sn = 1 To Sheets.Count
        For p = 1 To lMemberCount
            If ActiveSheet.Name = EmailList(p, 1) And EmailList(p, 3) = "ABC - 123 - DoReMi" Then
                Set rn = Nothing
                Set rn = ActiveSheet.UsedRange
                With rn
                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                    .BorderAround xlContinuous
                End With

                firstName = Split(EmailList(p, 1), ", ", 2)

                With objMail
                    .HTMLBody = ""
                    .To = EmailList(p, 2)
                    .Subject = "Subject as of"& dtime
                    StrBody = "<BODY style=font-size=11pt;font-family:Calibri>Hi "& firstName(1) & ",<br><br>"& _
                        "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
                    StrBody2 = "<br><br>Regards,<br><br>"
                    .HTMLBody = StrBody & RangetoHTML(rn) & "<br>"& StrBody2 & Signature
                    '.Display
                    .Send 'to send
                End With
                Set objMail = olApp.CreateItem(olMailItem)
                Exit For
            End If
        Next p
        On Error Resume Next
            Sheets(ActiveSheet.Index + 1).Activate
        If Err.Number <> 0 Then Sheets(1).Activate
    Next sn
End Sub

The problem in here is that whenever I run this code, the signature image only appears on the 1st email sent, but not on every other email sent.

Here's the resulting signature on other email sent using this code (signature with image screenshot will not be shown here for privacy purposes):

Also, as reference, but this also doesn't show the images, and I don't want to have a file explorer opened for picking signatures.