add signature in vba outlook

[ummjay]

Hi, I have the below running, but for some reason it doesn't include the user's signature? Any ideas? Note, different users may be using this, so would like to include whatever their default outlook signature is:

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


'On Error Resume Next
With OutMail
strbody = .htmlbody
    
    .To = "test"""
    .CC = "test@test.com"
    .Subject = "Recap for " & Name
    .htmlbody = RangetoHTML(rng)
    '.htmlbody = getNewHTML(.htmlbody, strName, 2, "XXNameXX")
    '.htmlbody = strBody & "<br>" & .htmlbody
    .Display

End With
On Error GoTo 0

Set OutMail = Nothing
          
cleanup:
    Set OutApp = Nothing
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True

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

Thanks!

 

[Anthony47]

Try

.htmlbody = RangetoHTML(rng) & .htmlbody

The added portin is in bold

 

[ummjay]

thanks, I tried that, but didn't do anything/add the signature.

 

[Anthony47]

That will preserve the outlook signature, if the user had set one in their profile

 

[Georgiboy]

Try also moving the '.Display' part to the top of that section:

Sub test()
    Dim rng As Range
    'Send Email
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
   
    Set rng = Range("C4:D5")
   
    'On Error Resume Next
    With OutMail
        .Display
        .To = "test"""
        .CC = "test@test.com"
        .Subject = "Recap for " & Name
        .htmlbody = RangetoHTML(rng) & .htmlbody
    End With
    On Error GoTo 0
   
    Set OutMail = Nothing
         
cleanup:
    Set OutApp = Nothing
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True

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

 

[ummjay]

Hi! So I added the .display first, like you suggested. I can see it composed my email with my signature, then when it went to add the table/htmlbody, it pasted that, and removed the signature. So seems that's whats causing it to be removed.

here is my rangetohtml code

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

 

[Anthony47]

Thus try replacing the line .htmlbody = RangetoHTML(rng) & .htmlbody with:

myTxt = RangetoHTML(rng)
.HTMLBody = myTxt & .HTMLBody

 

[Georgiboy]

Did you use the below?

.htmlbody = RangetoHTML(rng) & .htmlbody

Or just?

.htmlbody = RangetoHTML(rng)

 

[ummjay]

worked like a charm, thanks!