Adding signature to for loop email creaton

[godzilla185]

Hi,

I have a very useful code I made for work, which does the following:

1. removes duplicate client names
2. inserts contact list
3. Vlookup today's client names against the contact list to make the next step for client emails dynamic.
4. Generates emails to each client and inserts their corresponding excel files.

I got everything to work except the email signature in #4 (removed from code to show what is working so far)

The code for the email part is below (removed private information which is not relevant):
Columns H, I, J, and K hold respectively the "To", "Subject", "Body" and excel files to attach parts of the email.
I have looked at rondebruin and on this forum to add the signature part of the code and cannot get it to work. Am wondering if anyone can help.

...
Sub Email_and_AttachFile()

Dim r As Long
Dim m As Long
Dim sMail As String
Dim sFile As String
Dim oApp As Object
Dim oMsg As Object

Dim wd As Date
wd = WorksheetFunction.WorkDay(Date, -1)

Set oApp = CreateObject(Class:="Outlook.Application")
m = Range("K" & Rows.Count).End(xlUp).Row
For r = 2 To m

sFile = Range("K" & r).Value
Set oMsg = oApp.CreateItem(0)
With oMsg
.To = Range("H" & r).Value
.Subject = Range("I" & r).Value
.Body = "Good morning," & vbNewLine & Format(wd, "dd mmm yyyy") _
& Range("J" & r).Value & vbNewLine & "Many thanks," & vbNewLine & Signature

.CC = "bob”"
.Attachments.Add sFile
.Display

End With

Next r

End Sub

 

[breynolds0431]

Hi. Which method did you try of Ron de Bruin's? The first one will open an email up first, which would automatically populate the default email signature, and then adds the pertinent information (i.e.; To, Subject, Body, etc.). The second method requires knowing the name of the signature file, which is usually a problem when more than one person is using the code to generate emails.

I adapted your code using Ron's first method below. Hopefully that works out for you.

Sub Email_and_AttachFile()

Dim r As Long
Dim sMail As String, sFile As String
Dim oApp As Object: Set oApp = CreateObject(Class:="Outlook.Application")
Dim oMsg As Object

Dim wd As Date: wd = WorksheetFunction.WorkDay(Date, -1)
Dim m As Long: m = Range("K" & Rows.Count).End(xlUp).Row
Dim strbody As String

For r = 2 To m

    sFile = Range("K" & r).Value
    Set oMsg = oApp.CreateItem(0)
    
    strbody = "Good morning, <br><br>" & Format(wd, "dd mmm yyyy") & "<br><br>" & _
              "Let me know if you have problems.<br>" & Range("J" & r).Value & _
              "<br><br>Many thanks,"

    With oMsg
        .Display
        .To = Range("H" & r).Value
        .Subject = Range("I" & r).Value
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .CC = "bob"
        .Attachments.Add sFile
        .Display
    End With

Next r

End Sub