Excel VBA - 循环发送电子邮件 - 仅发送一封电子邮件

问题描述

我从 stackoverflow 上的其他线程之一获得了此代码。我稍微修改了一下。

这适用于发送一封电子邮件。但是,当我在循环中使用此代码时,它只执行最后一封电子邮件。我之前没有使用过 cdo.message、CDO.Config 和 Fields。知道为什么会这样吗?

'Part of a procedure
   eBody = "html body"
   With shTemp
      For i = 2 To lastRow
         toEmail = "emailAddress"
         eAttachment1 = "path1"
         eAttachment2 = "path2"
         
         sendEmail = emailPDFs(toEmail,eBody,eAttachment1,eAttachment2)
      Next i
   End With
'=========

Function emailPDFs(toEmail As String,eBody As String,eAttachment1 As String,eAttachment2 As String)
    Dim imsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    
    Set imsg = CreateObject("cdo.message")
    Set iConf = CreateObject("CDO.Configuration")

   iConf.Load -1    
   Set Flds = iConf.Fields
   With Flds
       .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                      = "smtp.sendgrid.net"
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
       .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxx"
       .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxx"
       .Update
   End With

    With imsg
        Set .Configuration = iConf
        .To = toEmail
        .From = "..."
        .Subject = "Test email"
        .AddAttachment eAttachment1
        .AddAttachment eAttachment2
        .htmlBody = eBody
        .send    
    End With
        
End Function

解决方法

暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!

如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@)