Multiple signatures in email

[wmtsub]

I am using a script from Run De Bruin to email from excel.
However it pulls the signature from the default email account.
How can i create multiple signatures and swap them based on a cells content?
IE. if b1 - mike then the email would be mikes signature, if b1 = steve then it would use steve's signature.

' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    sSignature = .htmlbody

 

[wmtsub]

Re: Multiple signitures in email

How do I get this code to read/display the art work /picture in the signature?
It is only displaying the text and a red placeholder for the pic.

Sub testemail()
[COLOR=#008000]'-----------------------------------------
'DETERMINE IF EMAIL TO BE SENT[/COLOR]
If MsgBox("Send Email?", vbYesNo + vbQuestion, "Email") = vbYes Then
[COLOR=#008000]'-----------------------------------------
'DECLARE AND SET VARIABLES[/COLOR]
    Dim myOutlok As Object
    Dim myMailItm As Object
    Dim Signature As String
    Shell ("OUTLOOK")
    Set otlApp = CreateObject("Outlook.Application")
    Set OtlNewMail = otlApp.CreateItem(olMailItem)
[COLOR=#008000]'-----------------------------------------
'GET DEFAULT EMAIL SIGNATURE[/COLOR]
    Signature = Environ("appdata") & "\Microsoft\Signatures\"
    If Dir(Signature, vbDirectory) <> vbNullString Then
        Signature = Signature & Dir$(Signature & "*.htm")
    Else:
        Signature = ""
    End If
    Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll
[COLOR=#008000]'-----------------------------------------
'CREATE EMAIL[/COLOR]
    OtlNewMail.HTMLBody = Signature
    With OtlNewMail
    .To = Range("H9").Value
    .CC = Range("H10").Value
    .Subject = Range("H11").Value
    .HTMLBody = "Hello," & "<br />" & Range("H12").Value & "<br />" & "<br />" & "<br />" & _
        "Thank you," & "<br />" & "<br />" & Signature
    .display
    '.Send
    End With
[COLOR=#008000]'-----------------------------------------
'CLEANUP[/COLOR]
    Set OtlNewMail = Nothing
    Set otlApp = Nothing
    Set otlAttach = Nothing
    Set otlMess = Nothing
    Set otlNSpace = Nothing
End If
End Sub