Auto Outlook Signature gets deleted after inserting Excel Range template in Email body

[PremPrakash]

Hi Experts,

Below is the line of code, I'm using to filter blank cells from a specific column and pasting the same to new tab.

Everything works fine. When an Outlook email opens, I can see my Outlook signature in the email body. There are some HTML lines been added, later once the excel filter table gets added to the email, my signature gets deleted

Option Explicit
Sub test()
    Dim r As Range
    Dim Mail As Object, Dict As Object, Rng As Range, Email As String, Recipient As String, i As Long
    Sheets("Output").Cells(1).CurrentRegion.Clear
    With Sheets("Data").Cells(1).CurrentRegion
        .Range("b1:c1,e1,h1:i1").Copy Sheets("Output").[a1]
        Set r = .Offset(, .Columns.Count + 1).Range("a1:a2")
        r(2).Formula = "=h2="""""
        .AdvancedFilter 2, r, Sheets("Output").Cells(1).CurrentRegion
        Worksheets("Output").UsedRange.EntireColumn.AutoFit
        Worksheets("Output").UsedRange.EntireRow.AutoFit
        r.Clear
    End With
    
Set Mail = CreateObject("Outlook.Application")
Set Dict = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    Email = Range("E" & i).Value
    Recipient = Split(Email, "@")(0)
    If Not Dict.exists(Email) Then
        Dict.Add Email, ""
        With Cells(1).CurrentRegion
            .AutoFilter 5, Email
            Set Rng = .SpecialCells(12)
            With Mail.CreateItem(0)
                .Display
                .To = Email
                .Subject = "Monthly Audits" & " - " & Format(Date - Day(Date), "mmmm yyyy")
                .HTMLBody = "<p style='font-family:arial;font-size:15'>" & "Hello " & Recipient & "," & "<br>" & "<br>" & "Please find attached the above invoices and backup" & "<br>" & "</p>" _
                & "<p style='font-family:arial;font-size:15'>Any queries please let me know </p>"
                .HTMLBody = .HTMLBody & RangetoHTML(Rng) '& "<p style='font-family:arial;font-size:15'>" & "<br>" & "Regards" & "<br>" & "Prem"
                '.Display
            End With
            .AutoFilter
        End With
    End If
Next i
End Sub
Function RangetoHTML(Rng As Range)
    Dim fso As Object, ts As Object, TempWB As Workbook, TempFile As String
    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 xlPasteAll, , False, False
        Application.CutCopyMode = False
    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 0
    Kill TempFile
    Set ts = Nothing: Set fso = Nothing: Set TempWB = Nothing
End Function

Can you please advise, as where I'm going wrong.

See attached excel for your reference

Copy Blank Rows.xlsb
	I
8
Output

 

[shknbk2]

How about changing your HTMLBody to this?

.HTMLBody = "<p style='font-family:arial;font-size:15'>" & "Hello " & Recipient & "," & "<br>" & "<br>" & "Please find attached the above invoices and backup" & "<br>" & "</p>" _
               & "<p style='font-family:arial;font-size:15'>Any queries please let me know </p>" & RangetoHTML(Rng) & .HTMLBody

When the email gets created, HTMLBody contains your signature. However, you overwrite HTMLBody completely without including the signature.

 

[PremPrakash]

Perfect! I small piece of code adjustment, and this worked.

Thank you! for a help

 

[shknbk2]

You're welcome. Glad to help.

 

[smozgur]

@PremPrakash: Welcome to the MrExcel Message Board!

Perfect! I small piece of code adjustment, and this worked.

Thank you! for a help

I changed the marked solution post accordingly.

To help future readers, it is better to mark the post as the solution that answered your question. That would be great if you could do the same in your future threads.
No further action is required for this thread.