Trying to add a default signature into an email from VBA

**murp5972** · 07-10-2015, 09:12 AM

My email code currently works just fine, but I want to add a signature right after the "Sincerely," in the body text. The signature is saved as a JPEG and its uploaded into outlook as a default signature however it doesn't show up. I would prefer my code to include it automatically at the end of the body text. What would I have to add to my code to achieve this?Thanks so much!

Heres the code:

Sub Mail_workbook_Outlook_1()
    Dim OutApp As Object
    Dim OutMail As Outlook.MailItem

    EmailTo = Worksheets("E-mail Sheet").Range("B26")
    
    Dim Found As Range
    
    EmailTo = Worksheets("E-mail Sheet").Range("B26")
    
    Set Found = Sheets("Current Clients").Columns("C").Find(What:=Sheets("E-mail Sheet").Range("A26").Value, _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                                               
    If Not Found Is Nothing Then
        If IsEmpty(Found.Offset(, -2)) = False Then
            If MsgBox(Range("A26").Value & vbNewLine & vbNewLine & "An item request has  been sent on: " & Found.Offset(, -2).Value & vbNewLine & _
            "Items were recieved on: " & Found.Offset(, -1).Value & vbNewLine & vbNewLine & "See Current Clients page for more information" & vbNewLine & vbNewLine _
            & "Do you want to continue?", vbYesNo) = vbNo Then
                Exit Sub ' stop macro if user selects No
            End If
        End If
    End If

    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = Worksheets("E-mail Sheet").Range("B26")
        .CC = Worksheets("E-mail Sheet").Range("B19")
        .BCC = ""
        .Subject = "Updating Credit File - " & Worksheets("E-mail Sheet").Range("D26")
        .Body = "Dear " & Worksheets("E-mail Sheet").Range("C26") & "," & vbNewLine & vbNewLine & _
        "We are requesting the following information to bring your credit file up to date." & vbNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B2") _
        & Worksheets("E-mail Sheet").Range("C2") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B3") & Worksheets("E-mail Sheet").Range("C3") _
        & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B4") & Worksheets("E-mail Sheet").Range("C4") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B5") _
        & Worksheets("E-mail Sheet").Range("C5") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B6") _
        & Worksheets("E-mail Sheet").Range("C6") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B7") _
        & Worksheets("E-mail Sheet").Range("C7") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B8") _
        & Worksheets("E-mail Sheet").Range("C8") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B9") _
        & Worksheets("E-mail Sheet").Range("C9") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B10") _
        & Worksheets("E-mail Sheet").Range("C10") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B11") _
        & Worksheets("E-mail Sheet").Range("C11") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B12") _
        & Worksheets("E-mail Sheet").Range("C12") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B13") _
        & Worksheets("E-mail Sheet").Range("C13") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B14") _
        & Worksheets("E-mail Sheet").Range("C14") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B15") _
        & Worksheets("E-mail Sheet").Range("C15") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B16") _
        & Worksheets("E-mail Sheet").Range("C16") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B17") _
        & Worksheets("E-mail Sheet").Range("C17") & vbNewLine & vbNewLine & "If possible please provide us this information by " & Worksheets("E-mail Sheet").Range("A2") _
        & vbNewLine & vbNewLine & "If you have any questions please contact " & Worksheets("E-mail Sheet").Range("A19") & "at " & Worksheets("E-mail Sheet").Range("C19") _
        & vbNewLine & vbNewLine & "Sincerely,"
        .SendUsingAccount = OutApp.Session.Accounts.Item(2)

    .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

**Arkadi** · 07-10-2015, 09:15 AM

murp, this question has come up a few times in the past couple of days... you can search the forum if you like, but I have no problem helping. If I can ask... is it just the default signature that would normally be added by Outlook that you want to have in your email?

**Arkadi** · 07-10-2015, 09:21 AM

If the answer to the above is yes, then this should work:

Sub Mail_workbook_Outlook_1()
    Dim OutApp As Object
    Dim OutMail As Outlook.MailItem
    Dim signature As String
    
    EmailTo = Worksheets("E-mail Sheet").Range("B26")
    
    Dim Found As Range
    
    EmailTo = Worksheets("E-mail Sheet").Range("B26")
    
    Set Found = Sheets("Current Clients").Columns("C").Find(What:=Sheets("E-mail Sheet").Range("A26").Value, _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                                               
    If Not Found Is Nothing Then
        If IsEmpty(Found.Offset(, -2)) = False Then
            If MsgBox(Range("A26").Value & vbNewLine & vbNewLine & "An item request has  been sent on: " & Found.Offset(, -2).Value & vbNewLine & _
            "Items were recieved on: " & Found.Offset(, -1).Value & vbNewLine & vbNewLine & "See Current Clients page for more information" & vbNewLine & vbNewLine _
            & "Do you want to continue?", vbYesNo) = vbNo Then
                Exit Sub ' stop macro if user selects No
            End If
        End If
    End If

    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .display
        signature = .htmlBody
        .To = Worksheets("E-mail Sheet").Range("B26")
        .CC = Worksheets("E-mail Sheet").Range("B19")
        .BCC = ""
        .Subject = "Updating Credit File - " & Worksheets("E-mail Sheet").Range("D26")
        .htmlBody = "Dear " & Worksheets("E-mail Sheet").Range("C26") & "," & "<br><br>" & _
        "We are requesting the following information to bring your credit file up to date." & "<br><br>" & Worksheets("E-mail Sheet").Range("B2") _
        & Worksheets("E-mail Sheet").Range("C2") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B3") & Worksheets("E-mail Sheet").Range("C3") _
        & "<br><br>" & Worksheets("E-mail Sheet").Range("B4") & Worksheets("E-mail Sheet").Range("C4") & "<br><br>" & Worksheets("E-mail Sheet").Range("B5") _
        & Worksheets("E-mail Sheet").Range("C5") & "<br><br>" & Worksheets("E-mail Sheet").Range("B6") _
        & Worksheets("E-mail Sheet").Range("C6") & "<br><br>" & Worksheets("E-mail Sheet").Range("B7") _
        & Worksheets("E-mail Sheet").Range("C7") & "<br><br>" & Worksheets("E-mail Sheet").Range("B8") _
        & Worksheets("E-mail Sheet").Range("C8") & "<br><br>" & Worksheets("E-mail Sheet").Range("B9") _
        & Worksheets("E-mail Sheet").Range("C9") & "<br><br>" & Worksheets("E-mail Sheet").Range("B10") _
        & Worksheets("E-mail Sheet").Range("C10") & "<br><br>" & Worksheets("E-mail Sheet").Range("B11") _
        & Worksheets("E-mail Sheet").Range("C11") & "<br><br>" & Worksheets("E-mail Sheet").Range("B12") _
        & Worksheets("E-mail Sheet").Range("C12") & "<br><br>" & Worksheets("E-mail Sheet").Range("B13") _
        & Worksheets("E-mail Sheet").Range("C13") & "<br><br>" & Worksheets("E-mail Sheet").Range("B14") _
        & Worksheets("E-mail Sheet").Range("C14") & "<br><br>" & Worksheets("E-mail Sheet").Range("B15") _
        & Worksheets("E-mail Sheet").Range("C15") & "<br><br>" & Worksheets("E-mail Sheet").Range("B16") _
        & Worksheets("E-mail Sheet").Range("C16") & "<br><br>" & Worksheets("E-mail Sheet").Range("B17") _
        & Worksheets("E-mail Sheet").Range("C17") & "<br><br>" & "If possible please provide us this information by " & Worksheets("E-mail Sheet").Range("A2") _
        & "<br><br>" & "If you have any questions please contact " & Worksheets("E-mail Sheet").Range("A19") & "at " & Worksheets("E-mail Sheet").Range("C19") _
        & "<br><br>" & "Sincerely," & "<br><br>" & signature
        .display
        .SendUsingAccount = OutApp.Session.Accounts.Item(2)

    
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

**murp5972** · 07-10-2015, 10:29 AM

Arkadi, thanks for the reply!
I should have specified that the signature is a default for my 2nd email account, but it's not the default signature for the default email account. The code I have here sends the email from the 2nd Outlook account, so I figured it would pull that default signature with your code, however it is not. Any suggestions? Thanks again!

**Arkadi** · 07-10-2015, 10:48 AM

Try the code below... you will have to modify the red sections, the first one is the username of the account with the signarue (windows), and the second part is the name of the signature file. You can browse to the folder and find which htm file you need, mind you appdata won't show up unless you actually type it in, it is a hidden folder.

The only issue may be images in signature.. I'm not sure though.

Sub Mail_workbook_Outlook_1()
    Dim OutApp As Object
    Dim OutMail As Outlook.MailItem
    Dim signature As String
    
    EmailTo = Worksheets("E-mail Sheet").Range("B26")
    
    Dim Found As Range
    
    EmailTo = Worksheets("E-mail Sheet").Range("B26")
    
    Set Found = Sheets("Current Clients").Columns("C").Find(What:=Sheets("E-mail Sheet").Range("A26").Value, _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                                               
    If Not Found Is Nothing Then
        If IsEmpty(Found.Offset(, -2)) = False Then
            If MsgBox(Range("A26").Value & vbNewLine & vbNewLine & "An item request has  been sent on: " & Found.Offset(, -2).Value & vbNewLine & _
            "Items were recieved on: " & Found.Offset(, -1).Value & vbNewLine & vbNewLine & "See Current Clients page for more information" & vbNewLine & vbNewLine _
            & "Do you want to continue?", vbYesNo) = vbNo Then
                Exit Sub ' stop macro if user selects No
            End If
        End If
    End If

    signature = getboiler("C:\Users\username_here\AppData\Roaming\Microsoft\Signatures\specify_file.htm")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = Worksheets("E-mail Sheet").Range("B26")
        .CC = Worksheets("E-mail Sheet").Range("B19")
        .BCC = ""
        .Subject = "Updating Credit File - " & Worksheets("E-mail Sheet").Range("D26")
        .htmlBody = "Dear " & Worksheets("E-mail Sheet").Range("C26") & "," & "<br><br>" & _
        "We are requesting the following information to bring your credit file up to date." & "<br><br>" & Worksheets("E-mail Sheet").Range("B2") _
        & Worksheets("E-mail Sheet").Range("C2") & vNewLine & vbNewLine & Worksheets("E-mail Sheet").Range("B3") & Worksheets("E-mail Sheet").Range("C3") _
        & "<br><br>" & Worksheets("E-mail Sheet").Range("B4") & Worksheets("E-mail Sheet").Range("C4") & "<br><br>" & Worksheets("E-mail Sheet").Range("B5") _
        & Worksheets("E-mail Sheet").Range("C5") & "<br><br>" & Worksheets("E-mail Sheet").Range("B6") _
        & Worksheets("E-mail Sheet").Range("C6") & "<br><br>" & Worksheets("E-mail Sheet").Range("B7") _
        & Worksheets("E-mail Sheet").Range("C7") & "<br><br>" & Worksheets("E-mail Sheet").Range("B8") _
        & Worksheets("E-mail Sheet").Range("C8") & "<br><br>" & Worksheets("E-mail Sheet").Range("B9") _
        & Worksheets("E-mail Sheet").Range("C9") & "<br><br>" & Worksheets("E-mail Sheet").Range("B10") _
        & Worksheets("E-mail Sheet").Range("C10") & "<br><br>" & Worksheets("E-mail Sheet").Range("B11") _
        & Worksheets("E-mail Sheet").Range("C11") & "<br><br>" & Worksheets("E-mail Sheet").Range("B12") _
        & Worksheets("E-mail Sheet").Range("C12") & "<br><br>" & Worksheets("E-mail Sheet").Range("B13") _
        & Worksheets("E-mail Sheet").Range("C13") & "<br><br>" & Worksheets("E-mail Sheet").Range("B14") _
        & Worksheets("E-mail Sheet").Range("C14") & "<br><br>" & Worksheets("E-mail Sheet").Range("B15") _
        & Worksheets("E-mail Sheet").Range("C15") & "<br><br>" & Worksheets("E-mail Sheet").Range("B16") _
        & Worksheets("E-mail Sheet").Range("C16") & "<br><br>" & Worksheets("E-mail Sheet").Range("B17") _
        & Worksheets("E-mail Sheet").Range("C17") & "<br><br>" & "If possible please provide us this information by " & Worksheets("E-mail Sheet").Range("A2") _
        & "<br><br>" & "If you have any questions please contact " & Worksheets("E-mail Sheet").Range("A19") & "at " & Worksheets("E-mail Sheet").Range("C19") _
        & "<br><br>" & "Sincerely," & "<br><br>" & signature
        .display
        .SendUsingAccount = OutApp.Session.Accounts.Item(2)

    
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Snippet from code originally posted on mrexcel.com
'**** 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

EDIT: Images should work fine...

**murp5972** · 07-10-2015, 11:10 AM

Hi Arkadi,

I'm now getting the "file not found" error messaage. To clarify, the "username_here" needs to be edited to the username of the outlook account i want the eamil to be sent from? And does the "specify_file" need to be simply the file name or its entire file path. Thanks for your help!

**Arkadi** · 07-10-2015, 11:13 AM

username for windows user logged in. specify file is just the part of the file without htm... i've given the rest of the path

if you put C:\Users\username_here\AppData\Roaming\Microsoft\Signatures in windows explorer window you should be able to see the signature files... but username_here is the windows login name

**murp5972** · 07-10-2015, 11:28 AM

I'm not finding the signature file within a signature folder anywhere. The signature however is saved to my desktop as a .jpg titled "Loan Admin" and its title within outlook is also "Loan Admin". I'm working from a remote desktop with many user's if you think that might make a difference.

**murp5972** · 07-10-2015, 01:31 PM

Edit: I unhid the hidden folders and found the Signatures folder. I can see that my .htm file name is "Loan Admin". Everything works now except for the picture in the signature "cannot be displayed" any suggestions? Thanks!

**Arkadi** · 07-10-2015, 02:01 PM

I had the same problem... Saved, re-opened, and picture was OK... Maybe try that? Not sure otherwise...

**murp5972** · 07-13-2015, 09:33 AM

Just checked back in from the weekend. Still getting the same problem with the image in the signature not being displayed, but everything else works just fine. I tried to save and re-open but it doesnn't seem to help.

Trying to add a default signature into an email from VBA

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Re: Trying to add a default signature into an email from VBA

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] default email signature

[SOLVED] Excel VBA code for saving PDF to file & adding default signature to Email

generating automatic email with default signature and hyperlink

send selected range in email with default outlook email signature included

Unable to link default email signature to email

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions