outlook VBA: how to add alternative signature to email instead of the default

have you tried Ron's code?

http://www.rondebruin.nl/win/s1/outlook/signature.htm

I have, and this is great for creating new emails,
but mine is going to be a reply or forward to an existing email, keeping the existing attachments and email string.

btw, this is the code I already have and where I only need to add the signature change

Sub ForwardActiveItem()

Dim Inbox As MAPIFolder
Dim MyItems As Items
Dim MyItem As MailItem


Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set MyItems = Inbox.Items
Set MyItem = Application.ActiveExplorer.Selection(1)
Set MyItem = MyItem.Forward


    Dim subject As String
    subject = MyItem.subject
    subject = Replace(subject, "Verification needed of", "AWB needed for")
    
    MyItem.subject = subject
    
MyItem.Recipients.Add "mail@email.com"

MyItem.Display

End Sub

Outlook VBA is not really my area but all i can suggest is maybe something like the below code
whereby you "grab" the signature and shove it into the body
it works in my trial but....i found the formatting to be off because my signature is in HTML

Sub ForwardActiveItem()

Dim Inbox As MAPIFolder
Dim MyItems As Items
Dim MyItem As MailItem

Dim OApp As Object, OMail As Object, signature As String
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
    With OMail
    .Display
    End With
        signature = OMail.Body
    OMail.Close 1
    
Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set MyItems = Inbox.Items
Set MyItem = Application.ActiveExplorer.Selection(1)
Set MyItem = MyItem.Forward


    Dim subject As String
    subject = MyItem.subject
    subject = Replace(subject, "Verification needed of", "AWB needed for")
    
    MyItem.subject = subject
    MyItem.Body = signature & MyItem.Body
    
MyItem.Recipients.Add "mail@email.com"

MyItem.Display

End Sub

Sub Forward_Mail_Outlook_With_Signature_Html_2()
'
' http://www.rondebruin.nl/win/s1/outlook/signature.htm
'
' Don't forget to copy the function GetBoiler in the module.
'
    Dim MyItem As Object
    Dim MyFwdItem As mailItem
    
    Dim SigString As String
    Dim Signature As String

    Set MyItem = ActiveExplorer.Selection(1)
    
    If MyItem.Class = olMail Then
    
        Set MyFwdItem = MyItem.Forward

        'Change only Mysig.htm to the name of your signature
        'SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Mysig.htm"
                
        SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Invoice template.htm"

        If Dir(SigString) <> "" Then
            Signature = GetBoiler(SigString)
        Else
            Signature = ""
        End If

        With MyFwdItem
            .subject = "This is the Subject line"
            .HTMLBody = "<br>" & Signature & .HTMLBody
            .Display
        End With
    Else
    
        MsgBox "Select a mailitem."
        
    End If
    
ExitRoutine:
    Set MyItem = Nothing
    Set MyFwdItem = Nothing

End Sub

Private Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

wow very old thread

        With MyFwdItem
            .To = "mail@mail.com"
            .HTMLBody = "<br>" & Signature & .HTMLBody
            .Display
            '.Send
        End With

cant you just add .subject?
like so

       With MyFwdItem
            .subject = "This is the Subject line"

Sub ForwardCItoWestcon()
    
    Dim MyItem As Object
    Dim MyItems As Items
    Dim MyFwdItem As MailItem
    Dim strSub As String
    
    Dim SigString As String 'dont think you need this anymore?
    Dim Signature As String
    
    Set MyItem = ActiveExplorer.Selection(1)
    
    If MyItem.Class = olMail Then
    
        strSub = MyItem.subject
        strSub = Replace(strSub, "Verification needed of", "AWB needed for")
        strSub = Replace(strSub, "RE: ", "")
        strSub = Replace(strSub, "FW: ", "")
        ' add more code to change alter strSUB here if you want 

        Set MyFwdItem = MyItem.Forward

'code for Signature, if none found in default location it will put no signature in

        Signature = Environ("appdata") & "\Microsoft\Signatures\" 'default signature location
        
        If Dir(Signature, vbDirectory) <> vbNullString Then
            Signature = Signature & Dir$(Signature & "*.htm")
            Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll
        Else:
            Signature = ""
        End If
        

'set email parameters
        With MyFwdItem
            .To = "mail@mail.com"
            .subject = strSub
            .HTMLBody = "<br>" & Signature & .HTMLBody
            .Display
            '.Send
        End With
        Else
            MsgBox "Select a mailitem."
        End If
    
' mark selected email as UNread & processing category
    Dim obj As Object
    Set obj = Application.ActiveExplorer.Selection(1)
    obj.UnRead = True
    obj.Categories = "Processing"
    obj.Save
    
    
ExitRoutine:
    Set MyItem = Nothing
    Set MyFwdItem = Nothing

End Sub

what you had above for subject, i modified it slightly
made the variable strSub instead of subject to make it more clear

also you dont need boiler separate i added it directly into the code

cleaned it up some more and added more descriptions

Option Explicit
Sub ForwardCItoWestcon()
    
    Dim MyItem As Object 'original email
    Dim MyFwdItem As MailItem 'forward email
    
    Dim strSub As String 'subject string
    Dim Signature As String 'signature string
    
    Set MyItem = ActiveExplorer.Selection(1)
    
    If MyItem.Class = olMail Then 'check if mail item is selected
    
        'code to change & manipulate subject of forward email
        strSub = MyItem.subject
        strSub = Replace(strSub, "Verification", "AWB")
        strSub = Replace(strSub, "RE: ", "")
        strSub = Replace(strSub, "FW: ", "")
        
        Set MyFwdItem = MyItem.Forward
        
        'code to select signature from default location. if none found it will put signature as blank
        Signature = Environ("appdata") & "\Microsoft\Signatures\" 'default signature location
        If Dir(Signature, vbDirectory) <> vbNullString Then
            Signature = Signature & Dir$(Signature & "*.htm")
            Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll
        Else:
            Signature = ""
        End If

        'set email parameters
        With MyFwdItem
            .To = "mail@mail.com"
            .subject = strSub
            .HTMLBody = "<br>" & Signature & .HTMLBody
            .Display
            '.Send
        End With
    
' mark selected email as UNread & processing category
        MyItem.UnRead = True
        MyItem.Categories = "Processing"
        MyItem.Save
        Set MyFwdItem = Nothing
    
    Else
        MsgBox "Select a mailitem and try again"
    End If

    Set MyItem = Nothing

End Sub

i am assuming you only want to mark unread & "processing" for mail items which you actually process

not a problem
good to hear

i learnt a thing or two since you first started the thread

Thanks humdingaling for code that is very useful.

I know this is an old thread, however if there is an embedded image in the Signature, the embedded image will not be displayed. The following code (important parts in red) should take care of that problem:

Sub TestLjmGetOutlookSignature()
  'This assumes that Outlook is already open to simplify the code
  
  'Reference: http://www.w3schools.com/html/html_paragraphs.asp
  'Reference: http://www.html.am/html-codes/text/
  
  Dim OutApp As Object
  Dim OutMail As Object
  Dim sSignatureHTML As String
  Dim sSignatureName As String
  
  
 'Attempt to create an Outlook object
  On Error Resume Next
  Set OutApp = GetObject(, "Outlook.Application")
  If Err.Number <> 0 Then
    Err.Clear
    MsgBox "NOTHING DONE.  The Outlook Object could not be created from Excel." & vbCrLf & _
           "Try again when Outlook is open."
    Exit Sub
  End If
  On Error GoTo 0
  
  
  'Create the Outlook Mail Object (using the default Email account)
  Set OutMail = OutApp.CreateItem(0)
 
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Grab the Signature HTML as a text string
  'The 'Default Signature' will be used if the Input Signature Name:
  'a. is BLANK or a NULL STRING
  'b. is DOES NOT EXIST
  'c. is SPELLED INCORRECTLY
  '
  'Use 'None' (CASE INSENSITIVE) to use NO SIGNATURE
  sSignatureName = "Signature03"    '<---- Change this line to your signature name
  sSignatureHTML = LjmGetOutlookSignature(OutMail, sSignatureName)
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'Determine the values to be sent
  With OutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Outlook Signature Test"
    .htmlbody = "Line one" & "<BR> " & "Line two" & sSignatureHTML
    
    .display
    
    '.Send - comment out the 'Display line' if you want to send
  End With
  
  'Clear the Object Pointers
  Set OutMail = Nothing
  Set OutApp = Nothing

End Sub

Function LjmGetOutlookSignature(OutMail As Object, sSignatureName As String) As String
  'This returns the Outlook Signature Requested as HTML text string
  '
  'If the Input value is 'NONE' (case insensitive), NO SIGNATURE is used
  '
  'The 'Default Signature' will be used if the Input Signature Name:
  'a. is BLANK or a NULL STRING
  'b. is DOES NOT EXIST
  'c. is SPELLED INCORRECTLY
  '
  'If there is NO DEFAULT Signature, the NULL STRING will be returned
  '
  'See Outlook Signatures for a list of available signatures
  '
  'Outlook Signatures are stored in the following typical folder:
  'C:\Users\Owner\AppData\Roaming\Microsoft\Signatures\
  '
  '
  'Reference: Post #11: http://www.excelforum.com/outlook-formatting-and-functions/1111961-outlook-vba-how-to-add-alternative-signature-to-email-instead-of-the-default.html
  'Thank you humdingaling
    
  'Define Double Quote Pseudo-Constant  ( " )
  Dim Q As String
  Q = Chr(34)
    
  Dim sOutlookSignatureFolder As String
  Dim sPathAndFileName As String
  Dim sReplacementTextAfter As String
  Dim sReplacementTextBefore As String
  Dim sSignatureHTML As String
  Dim sSignatureNameLocal As String
  
  'Create a local copy of the Signature Name (with leading/trailing spaces removed
  sSignatureNameLocal = Trim(sSignatureName)
  
  'Exit if the Input Signature is 'NONE' (case insensitive)
  If UCase(sSignatureNameLocal) = "NONE" Then
    Exit Function
  End If
  
    
  'Create the Path and File Name for Outlook Signatures
  sOutlookSignatureFolder = Environ("APPDATA") & "\Microsoft\Signatures\"
  sPathAndFileName = sOutlookSignatureFolder & sSignatureNameLocal & ".htm"
  
  'Disable Excel Error Processing (i.e. RUNTIME errors are disabled)
  On Error Resume Next
    
  'Get the Signature string (as HTML) if the Signature Exists
  sSignatureHTML = CreateObject("Scripting.FileSystemObject").GetFile(sPathAndFileName).OpenAsTextStream(1, -2).ReadAll
  Err.Clear
  
  'Add the explicit path to any images in the signature (otherwise the images will not be displayed)
  'For example, Replace text like: 'src="Signature03_' with  'src="C:\Users\Owner\AppData\Roaming\Microsoft\Signatures\Signature03_'
  If Len(sSignatureHTML) > 0 Then
    sReplacementTextBefore = "src=" & Q & sSignatureNameLocal & "_"
    sReplacementTextAfter = "src=" & Q & sOutlookSignatureFolder & sSignatureNameLocal & "_"
    sSignatureHTML = Replace(sSignatureHTML, sReplacementTextBefore, sReplacementTextAfter)
  End If
  
  'Resume normal error processing
  On Error GoTo 0
  
  'Grab the Default Signature if the requested signature does not exist
  If Len(sSignatureHTML) = 0 Then
    OutMail.display
    sSignatureHTML = OutMail.htmlbody
  End If
    
  'Return the signature HTML as a text string
  LjmGetOutlookSignature = sSignatureHTML
    
End Function

Lewis