使用带有 HTML 正文和签名的 SMTP 发送电子邮件

Question

设法使用 Excel 和 SMTP 发送此邮件。

一次发送一封电子邮件时，第一封电子邮件的签名显示在应有的位置。
发送的第二封电子邮件有签名，但将签名添加为附件。
发送的第三封电子邮件有签名，但将签名添加为附件两次，并且将重复添加更多签名图像作为附件的循环。

TLDR：

已发送 1 封电子邮件 = 0 个附件
已发送 2 封电子邮件 = 1 个附件
已发送 3 封电子邮件 = 2 个附件

我不想要任何附件。

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

已完成删除。Attachments.Add 路径和签名徽标，0

对于 .HTMLBody = mail_body_message 更改为以下（修复） .HTMLBody = mail_body_message & " "

Answer 2

因为你们是re-using同一个对象就在开始的时候附上一次标志。

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

使用带有 HTML 正文和签名的 SMTP 发送电子邮件

Send E-mail using SMTP with HTML Body & Signature

excel

vba

smtp

signature