Send E-mail using SMTP with HTML Body & Signature

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