Solved vba inseret signature (with jpeg)

[GaryPanic]

OK feeling a little "gifted" -
I was edited the wrong blinking file .....
for those that may come along later ...
find your signature html file .. then open this in notepad .. then add the file reference.....

I was doing something different ..(I was opening up the notepad that had the same name - no its the HTML file that you open up - and it askes what do you want to open up with (then notepad)...

please excuse me for being that little be dumb.. - but lesson learnt ...

thanks anyways ...

 

[theDBguy]

OK feeling a little "gifted" -
I was edited the wrong blinking file .....
for those that may come along later ...
find your signature html file .. then open this in notepad .. then add the file reference.....

I was doing something different ..(I was opening up the notepad that had the same name - no its the HTML file that you open up - and it askes what do you want to open up with (then notepad)...

please excuse me for being that little be dumb.. - but lesson learnt ...

thanks anyways ...

Hi. Glad to hear you got it sorted out. Cheers!

 

[GaryPanic]

God do I feel stupid.. but hope this helps others ...lol

 

[Enzephalon]

I know this thread is quite old, but for me that's the best code I found and even AI was not able to help me with my question.
The code runs perfectly creating new mail items. I tried now to add the signature on the fly before sending the mail. Idea behind is that my business signature should be different between mails sending to internal and external.
I added below code in ThisOutlookSession module.
Unfortunately, the mails send only shows placeholders for the images of my signature at the recipient.
There is obviously a difference in creating a new mail item and updating an already created mail item during send process. I tried save before sending, i tried display...nothing helps to get the mail including images properly. Any idea?

I am using Win11 with O365.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    If TypeName(Item) = "MailItem" Then
sSignature = ReadSignature("xyz.htm")
sSignature = Replace(sSignature, "%20", " ")
Set objMail = Item
With objMail
    '.To = "someEmailAddressHere"
    .Subject = "Sample signature test"
    .HTMLBody = "Here is your signature" & "<p><BR/><BR/></p>" & sSignature
     .HTMLBody = sSignature
     .Save
    .Display
    Cancel = True
End With

End If
End Sub

 

[Enzephalon]

I gave AI another try and started from the beginning. Finally I was able to achieve what I wanted.
strSigExt and strSigInt are constant strings holding the signature name.

Sorry, but I cannot save the sub EmbedSignatureImages as code here. It says that content might be spam -> I added as picture.

Option Explicit
Dim sSignature As String
Dim objRecipient As Outlook.Recipient
Dim strSig As String
Dim imgFolderPath As String
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeName(Item) = "MailItem" Then
    If Item.MessageClass = "IPM.Schedule.Meeting.Request" Or _
           Item.MessageClass = "IPM.Schedule.Meeting.Canceled" Or _
           Item.MessageClass = "IPM.Schedule.Meeting.Resp.Pos" Or _
           Item.MessageClass = "IPM.Schedule.Meeting.Resp.Neg" Or _
           Item.MessageClass = "IPM.Schedule.Meeting.Resp.Tent" Then
            Exit Sub
    End If
    For Each objRecipient In Item.Recipients
        If InStr(objRecipient.Address, "vitesco.com") = 0 And InStr(objRecipient.Address, "schaeffler.com") = 0 Then
            strSig = strSigExt
            Exit For
        Else
            strSig = strSigInt
            End If
       Next objRecipient
        sSignature = ReadSignature(strSig)
        sSignature = Replace(sSignature, "%20", " ")
        imgFolderPath = Environ("APPDATA") & "\Microsoft\Signatures" & "\" & Replace(strSig, ".htm", "_files\")
        EmbedSignatureImages Item, sSignature, imgFolderPath
        sSignature = Replace(sSignature, Replace(strSig, ".htm", "_files/"), Environ("APPDATA") & "\Microsoft\Signatures" & "\" & Replace(strSig, ".htm", "_files\"))
        With Item
            .HTMLBody = .HTMLBody & sSignature
            .Display
        End With
        'Cancel = True
    End If
End Sub

Public Function ReadSignature(sigName As String) As String
    Dim oFSO As Object, oTextStream As Object, sig As String
    Dim appDataDir As String, sigPath As String
    appDataDir = Environ("APPDATA") & "\Microsoft\Signatures"
    sigPath = appDataDir & "\" & sigName
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oTextStream = oFSO.OpenTextFile(sigPath)
    sig = oTextStream.ReadAll
    ReadSignature = sig
End Function

 

[Gasman]

Thanks for posting.
You need quite a high post count to post actual links here now.
Your solution is a good workaround.

Edit: So I assume you never mix and match the email addresses for external and internal?, as just one test would be enough?