I'm trying to change outlook email signatures automatically depending on a specific keyword on the subject.
On my first try I added the signature at the bottom of the email.
The signature came perfect including image and all but that there was an issue with the placement as the signature was appended at the very bottom of the email below the original text.
On my second try I set up a default signature that works as a placeholder. The macro then finds the placeholder and replaces it with the correct signature. The macro works and inserts the signature in the correct location but now the signature image is not showing up.
A couple weird things with the issue:
Image issue occurs only when composing new email. Image comes in correctly when replying or forwarding.
Signature looks okay on sender's outlook client (i.e. image is displayed before sending email).
Signature is not displayed on recipient's outlook client (tried outlook and iOS mail).
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMail As Outlook.MailItem
Dim strSignatureFile As String
Dim objFileSystem As Object
Dim objTextStream As Object
Dim strSignature As String
Dim sPath As String
If TypeOf Item Is MailItem Then
Set objMail = Item
emailSubject = "T "& LCase(objMail.Subject)
End If
test = "keyWord"
If InStr(emailSubject, test) = 0 Then
sPath = Environ("appdata") & "\Microsoft\Signatures\signature1.htm"
signImageFolderName = "signature1_files"
Else
sPath = Environ("appdata") & "\Microsoft\Signatures\signature2.htm"
signImageFolderName = "signature2_files"
End If
completeFolderPath = Environ("appdata") & "\Microsoft\Signatures\"& signImageFolderName
If Dir(sPath) <> "" Then
strSignature = GetSignature(sPath)
' Now replace this incomplete file path
' with complete path wherever it is used
strSignature = VBA.Replace(strSignature, signImageFolderName, completeFolderPath)
Else
strSignature = ""
End If
'Insert the signature to this email
bodySignature = "<HTML><BODY><br>"& strSignature & "</br></HTML></BODY>"
objMail.HTMLBody = Replace(objMail.HTMLBody, "SingaturePlaceHolder", bodySignature)
End Sub
Function GetSignature(fPath As String) As String
Dim fso As Object
Dim TSet As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set TSet = fso.GetFile(fPath).OpenAsTextStream(1, -2)
GetSignature = TSet.readall
TSet.Close
End Function