Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Retain signature in Outlook

Status
Not open for further replies.

Andrzejek

Programmer
Jan 10, 2006
8,486
5
38
US
I create an Outlook email from other application in VBA.
I can place a text in the Body of the email just fine, but that wipes out the signature.

Code:
Dim OutApp As New Outlook.Application
Dim OutMail As Outlook.MailItem

Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail[green]
    .Subject = "Some Subject text"
    .Display   [red]'I can see signature here just fine :)[/red]
    .Body = "Some Body text"
    .Display   [red]'Signature here is gone :([/red]
End With
Set OutMail = Nothing

Any trick to retain the Signature in the email [ponder]

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
I did try that. It works when signature has just text (although it does NOT retain the format of the text in the sig). But often there is an image, logo, etc. in the Signature, and that is lost. :-(

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Are you saying instead of:
[tt].Body = "Some Body text"[/tt]
I should be using:
[tt].HTMLBody = [blue]text with HTML Tags[/blue][/tt]
[ponder]

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Is the signature an outlook signature or a third party/add-in signature such as templafy? If an add-in sometimes even with html, it gets wiped out.

For standard signature can also try this code.

Code:
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
'[URL unfurl="true"]http://www.rondebruin.nl/win/s1/outlook/signature.htm[/URL]
'20160826
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.ReadAll
    ts.Close
End Function
Below code example is for the section where you are creating the email.
You will need to locate the name of the signature file on your drive.
Code:
'Change only Mysig.htm to the name of your signature

...
...
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\MySig.htm"
    
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
    
    On Error Resume Next
    
    With MailOutLook
        .bodyformat = 3      'Late binding in lieu of olFormatRichText
        .To = forwardto  '"myemailaddress@mail.com"
        '.CC = ""
        '.bcc = ""
        .Subject = stsubject 'Me.txtUCASEFilename
        .htmlbody = stBody & "<br>" & Signature
        '.Send
...
...

This example is for when the third party add-in signature gets wiped out. Found the example in a you tube video while trying to figure out another issue of pasting charts from excel. Signature is only text though, haven't gotten around to see/try to get a logo in there. If statement was because some emails kept the signature and some wipes out sig. If it happens on all of them, then don't really need an if statement.

Code:
'[URL unfurl="true"]https://www.youtube.com/watch?v=azrbskTsEKQ[/URL]
'20240524
...
...
Dim wordDoc As Variant
...
...
With OutMail
        sendfromAddress = OutApp.getnamespace("MAPI").Accounts.Item(1).smtpAddress
        sendfromName = OutApp.session.CurrentUser.Name
        .To = olTo '"team@123.com"
        .CC = Replace(olCc, "; " & sendfromName, "") ' Remove sender from cc as unnecessary
        .BCC = ""
        .Subject = olSubj '"Country Population Data " & Format(Date, "mm-dd-yyyy")
        .display
        
        Set wordDoc = OutMail.GetInspector.WordEditor
        With wordDoc.Range
            If InStr(filename, "Daily") > 0 Then
                'seems to remove signature, while other doesn't
                .insertParagraphafter
                .insertParagraphafter
                .insertafter "Thank you,"
                .insertParagraphafter
                .insertParagraphafter
                .insertafter  "Your Name"
            End If
        End With
        
        .HTMLBody = "<Body style = font-size: 12pt; font-family: Arial> " & _
                    olBody & .HTMLBody
...
...
 
Thanks for the help.
At this stage of the game, since customers want to use Outlook Templates (*.oft files) I may as well use the code from here: How to send email using MS Outlook Template

Looks promising, keeps the Signature [thumbsup2] , although I have some issues with simple:
[pre]
With NewEmail
.HtmlBody = Replace(.HtmlBody, "text in file", "I want this instead")
[/pre]
needs more work on my side....

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
>Are you saying instead of:

Actually, that simple variant doesn't normally work. Try

Code:
   [COLOR=blue]    Dim OutApp As New Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim Signature As String
    
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail
        .Subject = "Some Subject text"
        .Display
        Signature = .HTMLBody [COLOR=green]' grab existing HTML sig[/color]
        .HTMLBody = "<p>Hello</p><p>Just testing</p>" & Signature [COLOR=green]' rebuild HTML including sig (inelegant, but works)[/color]
        .Display [COLOR=green]' no this doesn't cause a second sig to be appended[/color]
    End With
    Set OutMail = Nothing[/color]
 
Thanks strongm,
Your code does grab the text from the sig, but not any image, logo, etc. :-(

This is just a 'proof-of-concept' for their 'copy-n-paste all over the email' process.
I may just get all their requirements and come back here with questions. Maybe they don't need any signatures in their emails... Who knows?

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
>Your code does grab the text from the sig, but not any image, logo, etc

Interesting. It does here ... but it is an inelegant hack to workaround Microsoft's ... feature.

here's a less hacky version

Code:
[COLOR=blue]    Dim OutApp As New Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim Signature As String
    
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail
        .Subject = "Some Subject text"
        .Display
        .HTMLBody = Replace(.HTMLBody, "<p class=MsoNormal><o:p>&nbsp;</o:p></p><p class=MsoNormal><o:p>&nbsp;</o:p></p>", "<p class=MsoNormal><o:p>Here's some body text</o:p></p><p class=MsoNormal><o:p>Let's see if it works</o:p></p><p class=MsoNormal><o:p>&nbsp;</o:p></p>")
        .Display [COLOR=green]' no this doesn't cause a second sig to be appended[/color]
    End With
    Set OutMail = Nothing[/color]
 
I just may make the Templates to work for me. [wink]
I know I stated that I could not replace HTML test:
[pre]
With NewEmail
.HtmlBody = Replace(.HtmlBody, "text in file", "I want this instead")
[/pre]
It was actually because I was trying to Replace this:
[pre]
With NewEmail
.HtmlBody = Replace(.HtmlBody, "[highlight #FCE94F]$[/highlight]Abcd[highlight #FCE94F]$[/highlight]", "Some Text")
[/pre]
and turned out, in the HTML in the Template I had:
[tt][highlight #FCE94F]$[/highlight]<span class=spelle>Abcd<\span>[highlight #FCE94F]$[/highlight][/tt]
so I could never find just '[tt]$Abcd$[/tt]'
I tried replacing $ with | - same problem. Reserved characters in HTML

But - what I can do is wrap my text in a simple A...A (or any 'regular' character)
[thumbsup2]

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
My 2c:

1. I insert HTML text to HTML message with function found in one of forums (and modified):
Code:
Private Function AddTextHTML(sSourceHTML As String, sInsertHTML, Optional sSource As String = "") As String
' insert text to message, with (local) error handling
' result: sInsertHTML + sSourceHTML
Dim vHTML As Variant, vSubHTML As Variant
On Error GoTo errH
' insert text
vHTML = Split(sSourceHTML, "<body")
vSubHTML = Split(vHTML(1), ">")
AddTextHTML = vHTML(0) & "<body" & vSubHTML(0) & ">" & sInsertHTML & Right(vHTML(1), Len(vHTML(1)) - Len(vSubHTML(0) & ">"))
Exit Function

errH:
Err.Clear
AddTextHTML = sInsertHTML & sSource
End Function
Where I pass sSourceHTML = MyMail.HTMLBody


2. image in signature:
There is no problem with default signature. If it is not this case, even if the signature is properly displayed in webbrowser control, adding HTML to message requires changing paths from relative to absolute, as stated in one of above posts.


combo
 
My last code example works without having to make any changes to the path. At least, it does here, with Outlook 2021. I suppose other mileage may vary.
 
@strongm
[tt]Set OutMail = OutApp.CreateItem(olMailItem)[/tt] creates mail with default signature. The path change is required (maybe not in Outlook 2021 though) if other signature defined in Outlook is to be programmatically inserted from the file. It may be a case when the user has more than one profile configured and account and signature file are defined by code.

combo
 
Ah, ok, yes, that's true. IF you are trying to use direct access to the sig files (which didn't seem to be what Andy was asking in the OP, where he is clearly working with the default sig) the path is an issue.

If you have a budget, then it might be worth looking at Outlook Redemption which makes automating Outlook email much easier, and includes a Signature object. Back in the days when I used to automate Outlook a lot (and that'll be over 25 years ago!) Redemption was a big lifesaver.
 
So, after a little poking around it looks like it is possible to do this without leveraging a modified signature file (mainly by emulating what that modification triggers). Just need to clean up the example code a bit.
 
Ok, try this example (definitelgh not production code!):

Code:
[COLOR=blue]Option Explicit

[COLOR=green]' Requires References set for Outlook library and VBScript regular expressions[/color]
Public Sub TextAndSig(Optional mySubject As String = "Default subject", Optional Recipient As String = "test@example.com", Optional SigName As String, Optional InsertText As String = "Just some simple text to insert")
    Dim OutApp As New Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim Signature As String
    Dim re As New RegExp
    Dim mymatches As MatchCollection
    
    Set OutMail = OutApp.CreateItem(olMailItem)
    With OutMail
        .To = Recipient
        .Subject = mySubject

        If SigName <> "" Then
            Signature = getasightml(SigName)
            
            [COLOR=green]' ok. deal with any images - patch html with inline reference,
            ' and attach the file from source location[/color]
            With re
                .MultiLine = True
                .Global = True
                .Pattern = "imagedata (src="")(.*?)(" & SigName & "_files[\\/])(.*?)"""
                Set mymatches = .Execute(Signature) [COLOR=green]' find all the image filenames in the 'signature', then add them as attachments[/color]
                OutMail.Attachments.Add CreateObject("WScript.Shell").SpecialFolders("appdata") & "\Microsoft\Signatures\" & Replace(mymatches(0).SubMatches(2), "/", "\") & mymatches(0).SubMatches(3), olByValue
                
                [COLOR=green]' now repolace the src image paths with an inline reference. Google cid: if you want to know more ...[/color]
                .Pattern = "(src="")(.*?)(" & SigName & "_files[\\/])(.*?"")"
                Signature = .Replace(Signature, "$1cid:$4")
            End With
        Else
             .Display [COLOR=green]' Need to do this to get default sig htmlbody set correctly[/color]
            Signature = .HTMLBody  
        End If
               
        [COLOR=green]' Now insert some text[/color]
        With re
            .MultiLine = True
            .Global = False
            .Pattern = "(<p class=MsoNormal><o:p>)(.*?)(</o:p></p>)"
            Debug.Print .Test(Signature)
            Set mymatches = .Execute(Signature)
            Signature = .Replace(Signature, "$1" & InsertText & "$3")
        End With
        '[COLOR=green] Set the HTMLbody to our modifiedf html[/color]
        .HTMLBody = Signature

        .Display [COLOR=green]' get Outlook to do any final patch ups[/color]
        .Send [COLOR=green]' And send it if we want[/color]
    End With
    Set OutMail = Nothing
End Sub

Public Function getasightml(signatureName As String) As String
    Dim htmlSigFile As String
    [COLOR=green]' Path to the html signature file[/color]
    htmlSigFile = CreateObject("WScript.Shell").SpecialFolders("appdata") & "\Microsoft\Signatures\" & signatureName & ".htm" 
    [COLOR=green]' Read the HTML signature file[/color]
    getasightml = CreateObject("Scripting.FileSystemObject").OpenTextFile(htmlSigFile, 1).readall 
End Function[/color]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top