Outlook VBA - Adding a signature to draft emails

[warren66]

Is it possible to select multiple emails in the Drafts Folder and run a macro (say via an icon on the QAT) which adds a pre-defined signature to all the selected drafts?

Any useful pointers and snippets of code would be most welcome.

Thanks in advance

Warren

[gmayor]

Frankly it would be better if you associated signatures with your accounts and then they are included when you create messages, however with some provisos the following should work, Change the signature as appropriate and test with a small number of messages in drafts,


Public Sub AddSignature()
'Graham Mayor - https://www.gmayor.com - Last updated - 11 Apr 2021
Dim FSO As Object, oSig As Object
Dim olItem As MailItem
Dim strPath As String
Dim strSignature As String
Const strSig As String = "Graham Mayor.htm" 'the signature to add - change as required

strPath = Environ("appdata") & "\Microsoft\Signatures\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oSig = FSO.OpenTextFile(strPath & strSig)
strSignature = oSig.ReadAll
oSig.Close

For Each olItem In Session.GetDefaultFolder(olFolderDrafts).items
If TypeName(olItem) = "MailItem" Then
With olItem
.BodyFormat = olFormatHTML
.HTMLBody = .HTMLBody & strSignature
.Display
'.Save
End With
End If
Next olItem
lbl_Exit:
Set FSO = Nothing
Set olItem = Nothing
Set oSig = Nothing
Exit Sub
End Sub

[warren66]

That's tremendous thanks, Graham. You've come to my rescue again!

The reason I need this is because the drafts are created by a third party application and when they appear in the drafts folder they have no signature on them.

For some reason, the graphics in the signature file are not being brought in, just a space where they should be.

Also, the macro runs on all the drafts in the folder, not just the selected ones. And when I save and close the draft, does not retain the signature.

Can the code be amended so it runs on just the selected mail items, and that it opens each one in sequence, adds the signature (including the graphics) and saves and closes it before performing the same action on the next one until all selected items have been modified.

I would be very grateful for a pointer how I could address these issues.

Many thanks

Warren

[adamhawes]

Just associate signatures with your accounts.

[warren66]

Just associate signatures with your accounts.

It's not as simple as that. The drafts are generated by a third-party program and the only way to add a signature seems to be to open each draft in the folder separately and add a signature.

The code which gmayor most kindly provided is almost the solution; it needs a couple of tweaks to make it perfect.

[gmayor]

To update a selection in the drafts folder

Option Explicit

Public Sub AddSignature()
'Graham Mayor - https://www.gmayor.com - Last updated - 12 Apr 2021
Dim FSO As Object, oSig As Object
Dim olItem As MailItem
Dim strPath As String
Dim strSignature As String
Const strSig As String = "Graham Mayor.htm" 'the signature to add - change as required


If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox "No Items selected!", vbCritical, "Error"
Exit Sub
End If


strPath = Environ("appdata") & "\Microsoft\Signatures\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oSig = FSO.OpenTextFile(strPath & strSig)
strSignature = oSig.ReadAll
oSig.Close


For Each olItem In Application.ActiveExplorer.Selection
If olItem.Parent = "Drafts" Then
If TypeName(olItem) = "MailItem" Then
With olItem
.BodyFormat = olFormatHTML
.HTMLBody = .HTMLBody & strSignature
.Save
End With
End If
End If
Next olItem
lbl_Exit:
Set FSO = Nothing
Set olItem = Nothing
Set oSig = Nothing
Exit Sub
End Sub