Adding a signature to Outlook email

[mikenelena]

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!

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

 

[mikenelena]

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

Micron, thanks for the tip on the variable declarations. I've have corrected that. You may be on to something with the variable value. It shows it = "". That didn't alarm me at first because I thought it was simply unable to show a graphic in the VB editor. Is string even the correct variable type for an html signature? Here is that Getboiler 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

 

[welshgasman]

You only add the strfooter after you have composed your html message.

Also I forgot about the header which is just before you start to build your html message.

The table part is just what I needed, you might just need the strheader? Same applies to the footer, where I was closing the table.

With objOutlookMsg
            .HTMLBody = strHeader & "<table border = '0' cellpadding = '5' cellspacing = '5'>"

Sorry about that.

 

[mikenelena]

You only add the strfooter after you have composed your html message.

Also I forgot about the header which is just before you start to build your html message.

The table part is just what I needed, you might just need the strheader? Same applies to the footer, where I was closing the table.

With objOutlookMsg
            .HTMLBody = strHeader & "<table border = '0' cellpadding = '5' cellspacing = '5'>"

Sorry about that.

No need to apologize. I am grateful for the help. So I've added the header, and the foot is certainly after the composition of the message. Still back to throwing the error I've seen all too often:

Run Time 287 Application-defined or object defined error. It comes at the line

.HTMLBody = .HTMLBody & strfooter

I've tried everything I can think of on that line, including these:

'.HTMLBody = strBody & SSignature
.HTMLBody = .HTMLBody & strfooter
'.HTMLBody = strBody & "</table>" & strfooter

 

[welshgasman]

Just a humerous aside

I saw your GetBoiler function and thought 'that's not what I posted' ?
The person who created that and I had his name in there was "'**** Kusleika" and the site has starred out his first name, which if it does again is d i c k :D

Did it here again.

 

[welshgasman]

No need to apologize. I am grateful for the help. So I've added the header, and the foot is certainly after the composition of the message. Still back to throwing the error I've seen all too often:

Run Time 287 Application-defined or object defined error. It comes at the line

.HTMLBody = .HTMLBody & strfooter

I've tried everything I can think of on that line, including these:

'.HTMLBody = strBody & SSignature
.HTMLBody = .HTMLBody & strfooter
'.HTMLBody = strBody & "</table>" & strfooter

You need to post the whole routine, as where that line had been placed, is critical? It needs to be within the mail message object block?

That is me for the night now, so if you are still having problems, I'll have a peek tomorrow.

 

[mikenelena]

You need to post the whole routine, as where that line had been placed, is critical?

Sorry... Forgive the commented mess. I tend to leave some of that until it works, then I clean it up.

Private Sub cmdSendInvoices_Click()

Dim appOL As Outlook.Application
Dim MailOL As Object
Dim strBody As String
Dim strPath As String, 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 As String, strTemplatePath As String, strSigPath As String, intBody As String, strheader As String, 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
.HTMLBody = strheader
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 & strfooter
'--------------------------------------------------------------------
'.HTMLBody = strBody & "</table>" & strfooter

Loop

End With

Next i

Set appOL = Nothing
Set MailOL = Nothing
End Sub

 

[Micron]

Is string even the correct variable type for an html signature?

Not if that 'thing' is a picture or number. String is for text only. Numbers (1234) can also be text (1234). They may look the same, but they are not really. Speaking for myself, it will take some time to review that code. Maybe that is your issue. What is SSignature? If it's an image I suspect you need to Dim as Object, but you have me at a disadvantage here. Never have tried to insert an image in the html in Access vba. HTML, sure. Should your string variable be something like
"img src=' " & SSignature & " ' " ? I have inserted spaces at the apostrophes/single quotes for clarification. I'm stabbing here as I don't see how you can pass an object to an html code.

 

[Micron]

I'll close off for the night by saying that I took a quick look at what appears to be the source for that code and yes, it is looking for a string. You mentioned that the function is returning "" to the variable. That would seem to be the next thing that has to be solved. Are you sure there is a signature at the file location you're passing to the function? Out put the path (e.g. Debug.Print) before the function call. Check that the path is valid and there is a signature file there that you are specifying.

Is the signature supposed to be the same one for every email sent? If so I would suggest not looping through the function 10x to get the same sig. Once should be enough.

 

[welshgasman]

The image for any signature is held in a subfolder with the same name as the signature and a "_files" added.?
Look at the html source of your signature.

Here is mine

 src="SSAFA%20NPT_files/image002.jpg" v:shapes="_x0000_i1025"><![endif]></span><span
  style='mso-spacerun:yes'> </span>www.ssafa.org.uk</a></span><span
  style='font-size:11.5pt;font-family:"Segoe UI","sans-serif";mso-fareast-font-family:
  "Times New Roman";color:#212121'><o:p></o:p></span></p>
 </td>
 </tr>

However when I send an email with that I do get a small pic as per the second picture.

Effectively my approach was to take the source of the signature, split it at an appropriate point, build your html and then sandwich them altogether in the correct order.

The reason being I believe as the path has not effectively been changed.?
If you edit that path to reflect the full path, then that *might* work.?, though not sure what a recipient would see.? I would expect a link to to a web image would be safer.

Never been a problem for me, as my sent mail would show the second image

 

[mikenelena]

Micron & welshgasman, thank you both very much for all the help on this. I did a lot of reading last night. I can't believe the barrels of electronic ink that have been spilled over this issue! I have a couple of appointments out of the office today, but I plan to be getting back into this later this afternoon/evening US east coast time. In addition to the 2 most recent suggestions you've both made, I have also found what seems to be a promising suggestion from Mab879 at Stackoverflow.com (Not sure of the etiquette surrounding the mention of other coding websites, so apologies if this is frowned upon.) Back in 2012, he wrote:

"My solution is to display an empty message first (with default signature!) and insert the intended strHTMLBody into the existing HTMLBody.
If, like PowerUser states, the signature is wiped out while editing HTMLBody you might consider storing the contents of ObjMail.HTMLBody into variable strTemp immediately after ObjMail.Display and add strTemp afterwards but that should not be necessary." How to add default signature in Outlook

and offered this code:

Sub X(strTo as string, strSubject as string, strHTMLBody as string)

   Dim OlApp As Outlook.Application   
   Dim ObjMail As Outlook.MailItem 

   Set OlApp = Outlook.Application
   Set ObjMail = OlApp.CreateItem(olMailItem)

   ObjMail.To = strTo
   ObjMail.Subject = strSubject   
   ObjMail.Display
   'You now have the default signature within ObjMail.HTMLBody.
   'Add this after adding strHTMLBody
   ObjMail.HTMLBody = strHTMLBody & ObjMail.HTMLBody

   'ObjMail.Send 'send immediately or 
   'ObjMail.close olSave 'save as draft
   'Set OlApp = Nothing

End sub

It looks promising... I look forward to trying it when I get a couple of hours available later today. In the meantime, I welcome any thought you guys might have on it.