Consulting

Results 1 to 6 of 6

Thread: Outlook VBA - Adding a signature to draft emails

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1

    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

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    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

  4. #4
    Just associate signatures with your accounts.

  5. #5
    Quote Originally Posted by adamhawes View Post
    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.

  6. #6
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •