Outlook VBA - Adding a signature to draft emails

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

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,

Code:

---

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

---

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

Just associate signatures with your accounts.

Quote:

---

Originally Posted by adamhawes

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.

To update a selection in the drafts folder

Code:

---

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

---