Adding a signature to Outlook email

mikenelena

Board Regular
Joined
Mar 5, 2018
Messages
139
Office Version
  1. 365
Platform
  1. Windows
My code is stripping out the e-mail signature at the line that adds the e-mail body text. The signature includes a small graphic, so that should be HTML. I've been fooling with this code for hours trying suggestions from many internet threads. Essentially we want to attach all PDF invoice files from a folder named for the recipient. Everything works but the signature, and the VBNewLine spacing. I am not committed to the particular style of this code. It is only what I've cobbled together from multiple online resources. If there is a more efficient way to code this that achieves what we need, I'm happy to use it. Thanks in advance for any help this group can offer!

VBA Code:
Private Sub cmdSendInvoices_Click()

Dim appOL As Outlook.Application
Dim MailOL As Object
Dim strBody As String
Dim strPath, strFileName As String
Dim fsFolder As Object
Dim fsFile As Object
Dim Pattern As String
Dim SSignature As String
Dim Adjuster As String

Dim Size As Integer
Size = Me.ctrlListBox.ListCount - 1
ReDim ListBoxContents(0 To Size) As String
Dim i As Integer

For i = 0 To Size
    ListBoxContents(i) = Me.ctrlListBox.ItemData(i)
Next i

For i = 0 To Size

Set appOL = GetObject(, "Outlook.Application")
Set MailOL = appOL.CreateItem(olMailItem)

Adjuster = DLookup("[AdjusterFirst]", "qryEmailFinal", "[Adjuster Full Name] = '" & ListBoxContents(i) & "'")

strBody = Adjuster & "," & vbNewLine & _
"The attached invoice(s) show as outstanding in our system.  Could we trouble you to check the payment status for us when you have a moment?  Please confirm you have received this e-mail."

With MailOL

strPath = "S:\OurPath\" & ListBoxContents(i) & "\"

Pattern = strPath & "*" & ".*"

strFileName = Dir(Pattern)

Do While strFileName <> ""
.Display
.To = DLookup("[Email]", "qryEmailFinal", "[Adjuster Full Name] = '" & ListBoxContents(i) & "'")
.Subject = "Overdue Invoices"
'.BodyFormat = olFormatHTML
.HTMLBody = strBody & vbNewLine & SSignature

.Attachments.Add strPath & strFileName
strFileName = Dir

Loop

End With

Next i

Set appOL = Nothing
Set MailOL = Nothing

End Sub
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
I don't see where this is being set to equal anything before you try to use it? Is it a global or module level variable?
SSignature
 
Upvote 0
For the signature, try what Micron suggested of setting that variable. Also, maybe this (I'm reading your problem as there's already a signature in the new email and you want to keep it):

VBA Code:
.HTMLBody = strBody & vbNewLine & SSignature & .HTMLBody

For the vbNewLine that is working correctly. Your email is in HTML so the line breaks need to be HTML characters not visual basic ones. For HTML you can do paragraphs <p> and line breaks <br />. Something like blah & "<br />" & moreblah.
 
Upvote 0
I don't see where this is being set to equal anything before you try to use it? Is it a global or module level variable?
SSignature
The variable wasn't set at all in the version of the code I posted... I've read many threads and posts on this, and it seems many are setting SSignature equal to the Object variable (MailOL) in my case. When I try that, it throws a Run Time error '287 Application-defined or object defined error. I can get either the signature to appear, or the e-mail body, but not both.
 
Upvote 0
For the signature, try what Micron suggested of setting that variable. Also, maybe this (I'm reading your problem as there's already a signature in the new email and you want to keep it):

VBA Code:
.HTMLBody = strBody & vbNewLine & SSignature & .HTMLBody

For the vbNewLine that is working correctly. Your email is in HTML so the line breaks need to be HTML characters not visual basic ones. For HTML you can do paragraphs <p> and line breaks <br />. Something like blah & "<br />" & moreblah.
Hi JonXL,

Thanks for the suggestion on the line break codes. That works now. Signature still eludes me though. I'm sure Micron is right, but I still get an error trying to set that variable. I'm not setting it correctly, but I just don't know what I should be setting it to.
 
Upvote 0
Here is how I handled it, quite a while back

HTH
Code:
 'Establish all the static Outlook Data

    ' Get appdata path
    strAppdata = Environ("Appdata")
    
    ' Set paths
    strTemplatePath = strAppdata & "\Microsoft\Templates"
    strSigPath = strAppdata & "\Microsoft\Signatures\Ssafa.htm"
    
    
    'Get the signature if it exists
    If Dir(strSigPath) <> "" Then
        strSignature = GetBoiler(strSigPath)
        intBody = InStr(strSignature, "<div class=WordSection1>")
        'intBody = InStr(strSignature, "<BODY>")
        strHeader = Left(strSignature, intBody + 24) ' 5
        strFooter = Mid(strSignature, intBody + 24) ' 6
    End If
then
Code:
   ' Now add the footer
            .HTMLBody = .HTMLBody & "</table>" & strFooter

Code:
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
    Set fso = Nothing
    Set ts = Nothing
End Function
 
Upvote 0
Here is how I handled it, quite a while back

HTH
Code:
'Establish all the static Outlook Data

    ' Get appdata path
    strAppdata = Environ("Appdata")
   
    ' Set paths
    strTemplatePath = strAppdata & "\Microsoft\Templates"
    strSigPath = strAppdata & "\Microsoft\Signatures\Ssafa.htm"
   
   
    'Get the signature if it exists
    If Dir(strSigPath) <> "" Then
        strSignature = GetBoiler(strSigPath)
        intBody = InStr(strSignature, "<div class=WordSection1>")
        'intBody = InStr(strSignature, "<BODY>")
        strHeader = Left(strSignature, intBody + 24) ' 5
        strFooter = Mid(strSignature, intBody + 24) ' 6
    End If
then
Code:
   ' Now add the footer
            .HTMLBody = .HTMLBody & "</table>" & strFooter

Code:
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
    Set fso = Nothing
    Set ts = Nothing
End Function
I appreciate the effort, but this isn't working for me. It won't even compile. I added the GetBoiler function to a new module, but the code highlights it and throws an error that it expected variable or procedure, not module. This is offending line:
VBA Code:
strSignature = GetBoiler(strSigPath)

Undoubtedly I'm doing something quite wrong here. This code looks more complicated than what I would expect for something as simple as adding a default email signature. I must be missing something...
 
Upvote 0
I only showed you what I used.? I was trying to show one method of doing what you want.?
I would expect you to Dim the variables and populate them as required.?

You should have Option Explicit at the top of your module and that will show any undeclared variables.

strSigPath is the path to the signature file. Unless yours is called the same as mine (and I highly doubt it) then you need to change the path.
 
Upvote 0
I only showed you what I used.? I was trying to show one method of doing what you want.?
I would expect you to Dim the variables and populate them as required.?

You should have Option Explicit at the top of your module and that will show any undeclared variables.

strSigPath is the path to the signature file. Unless yours is called the same as mine (and I highly doubt it) then you need to change the path.
Still failing. I've incorporated your code into mine. Maybe I have something off on the line order?


VBA Code:
Private Sub cmdSendInvoices_Click()

Dim appOL As Outlook.Application
Dim MailOL As Object
Dim strBody As String
Dim strPath, strFileName As String
Dim fsFolder As Object
Dim fsFile As Object
Dim Pattern As String
Dim SSignature As String
Dim Adjuster As String
Dim MySubject As String
Dim Body As String
Dim CCR As String
Dim strAppData, strTemplatePath, strSigPath, intBody, strheader, strfooter As String

Dim Size As Integer
Size = Me.ctrlListBox.ListCount - 1
ReDim ListBoxContents(0 To Size) As String
Dim i As Integer

For i = 0 To Size
    ListBoxContents(i) = Me.ctrlListBox.ItemData(i)
Next i

For i = 0 To Size

MySubject = Me.Subject
'Body = Me.Bodytxt
CCR = Me.ccRecipient

Set appOL = GetObject(, "Outlook.Application")
Set MailOL = appOL.CreateItem(olMailItem)

With MailOL
Adjuster = DLookup("[AdjusterFirst]", "qryEmailFinal", "[Adjuster Full Name] = '" & ListBoxContents(i) & "'")

strBody = Adjuster & "," & "<p>" & vbNewLine & _
"The attached invoice(s) show as outstanding in our system.  Could we trouble you to check the payment status for us when you have a moment?" & "<p>" & "Please confirm you have received this e-mail." & "<p>" & SSignature

strPath = "S:\User\OverdueTEST\" & ListBoxContents(i) & "\"
Pattern = strPath & "*" & ".*"
strFileName = Dir(Pattern)


Do While strFileName <> ""

.To = DLookup("[Email]", "qryEmailFinal", "[Adjuster Full Name] = '" & ListBoxContents(i) & "'")
.BCC = CCR
.Subject = MySubject
.BodyFormat = olFormatHTML
.Attachments.Add strPath & strFileName
.Display
'SSignature = .HTMLBody
strFileName = Dir

'--------------------------------------------------------------------
strAppData = Environ("Appdata")
    
    ' Set paths
    strTemplatePath = strAppData & "\Roaming\Microsoft\Templates"
    strSigPath = strAppData & "\Roaming\Microsoft\Signatures\Signature.htm"
        
    'Get the signature if it exists
    If Dir(strSigPath) <> "" Then
        SSignature = GetBoiler(strSigPath)
        intBody = InStr(SSignature, "<div class=WordSection1>")
        'intBody = InStr(strSignature, "<BODY>")
        strheader = Left(SSignature, intBody + 24) ' 5
        strfooter = Mid(SSignature, intBody + 24) ' 6
    End If
'.HTMLBody = strBody & SSignature
.HTMLBody = .HTMLBody & "</table>" & strfooter
'--------------------------------------------------------------------
'.HTMLBody = strBody

Loop

End With

Next i

Set appOL = Nothing
Set MailOL = Nothing

End Sub
 
Upvote 0
Did you step through the code and ensure that your variables have values? If not, how do you know that the variable equal to SSignature contains anything?
You are calling a function GetBoiler that's supposed to get that but don't show the code for it. Do you know whether or not the function even returns a value?
Last, you don't multi declare variables like this:
Dim strPath, strFileName As String
Only the last one is a string, the preceding are Variants. You have more than one line like that.
Dim strPath As String, strFileName As String
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top