Send E-mail using SMTP with HTML Body & Signature - excel

Question

Managed to get this sending using Excel with SMTP.
When sending one e-mail at a time, the first one has the signature displayed where it should be.
Second e-mail sent has the signature but adds the signature as an attachment.
Third e-mail sent has the signature but adds the signature as an attachment twice, and it will repeat the the cycle adding more signature images as attachments.
TLDR:
1 e-mail sent = 0 attachment
2 e-mails sent = 1 attachment
3 e-mails sent = 2 attachments
I don't want any attached files.
Sub SendMail()
Set MyEmail = CreateObject("CDO.Message")
Path = "C:\Users\Users1\Desktop\Signature\"
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Set sh2 = ThisWorkbook.Sheets("Sheet2")
Dim nDateTime As Date, oDateTime As Date
nDateTime = Now
oDateTime = nDateTime - 3
Dim last_row As Integer
last_row = Application.CountA(sh.Range("A:A"))
For i = 2 To last_row
Set emailConfig = MyEmail.Configuration
With MyEmail
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing")
= redacted
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver")
= redacted
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= redacted
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")
= redacted
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl")
= redacted
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername")
= redacted
emailConfig.Fields.Update
MyEmail.Configuration.Fields.Update
End With
mail_body_message = sh2.Range("D2")
serial_number = sh.Range("A" & i).Value
mail_body_message = Replace(mail_body_message, "replace_serial_here", serial_number)
Attachment = Path + Filename
signaturelogo = "userSignature.png"
With MyEmail
Attachment = Path + Filename
signaturelogo = "userSignature.png"
Path = "C:\Users\Users1\Desktop\Signature\"
.Subject = "Hello there (HTTPS) Serial: " & serial_number
.From = "redacted"
.To = sh.Range("B" & i).Value
.HTMLBody = mail_body_message
.Attachments.Add Path & signaturelogo, 0
End With
If sh.Range("C" & i).Value <= oDateTime Then
MyEmail.Send
End If
Next i
End Sub

Answer 1

Because you are re-using the same object just attach the logo once at the start.
Option Explicit
Sub SendMyMail()
Const LOGO = "C:\Users\Users1\Desktop\Signature\userSignature.png"
Const DAYS = 3
Const SCHEMA = "http://schemas.microsoft.com/cdo/configuration/"
' configure email
Dim MyEmail As Object
Set MyEmail = CreateObject("CDO.Message")
With MyEmail
With .Configuration.Fields
.Item(SCHEMA & "sendusing") = 2
.Item(SCHEMA & "smtpserver") = "smtp.#.com"
.Item(SCHEMA & "smtpserverport") = 465
.Item(SCHEMA & "smtpauthenticate") = 1
.Item(SCHEMA & "sendusername") = "###"
.Item(SCHEMA & "sendpassword") = "#"
.Item(SCHEMA & "smtpusessl") = 1
.Update
End With
' add logo
.AddAttachment LOGO
End With
Dim sh As Worksheet, sh2 As Worksheet
Dim serialno As String, n As Long, i As Long, last_row As Long
Set sh = ThisWorkbook.Sheets("Sheet1")
Set sh2 = ThisWorkbook.Sheets("Sheet2")
With sh
last_row = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i = 2 To last_row
If sh.Range("C" & i).Value <= Now - DAYS Then
serialno = sh.Range("A" & i).Value
With MyEmail
.Subject = "Hello there (HTTPS) Serial: " & serialno
.From = "redacted"
.To = sh.Range("B" & i).Value
.HTMLBody = Replace(sh2.Range("D2"), "replace_serial_here", serialno)
' send
On Error Resume Next
.Send
If Err.Number = 0 Then
n = n + 1
Else
MsgBox Err.Description, vbExclamation, "Error Row " & i
End If
On Error GoTo 0
End With
Else
'Debug.Print "Skipped row " & i & " = " & sh.Range("C" & i)
End If
Next
MsgBox n & " emails sent", vbInformation
End Sub

Answer 2

Ended up removing .Attachments.Add Path & signaturelogo, 0
For .HTMLBody = mail_body_message
Changed to below, (the fix)
.HTMLBody = mail_body_message & " "