[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]