For循环使用VBA发送电子邮件：仅发送第一封电子邮件

Question

对不起，如果这接近重复的问题或格式不正确，这对我来说是第一次。

在 VBA 中，我试图遍历我的电子表格并在单元格值等于 1 时发送电子邮件。此代码用于发送第一封电子邮件（或工作表中出现 1），但不执行发送第二个或任何其他电子邮件。

我已经使用F8循环了，只要有一个1，它就会选择“With Outmail”功能，但它只是在第一次出现后不发送电子邮件。

提前谢谢你。

Sub Send_Email_Function()
'This cycles through a worksheet and sends email reminders when due dates 
have not been met.

'Establish Variables and variable types
Dim OutApp As Object
Dim OutMail As Object
Dim RecEmail As String
Dim AgmtNum As String
Dim AgmtProduct As String
Dim AgmtDate As String
Dim i As Integer

'Create mail objects
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'Start "i" for looping
For i = 26 To 29

'Assign variables to table and
RecipientEmail = Sheet1.Cells(1, 3).Value
AgmtNum = Sheet1.Cells(i, 2).Value
AgmtProduct = Sheet1.Cells(i, 3).Value
AgmtDate = Sheet1.Cells(i, 5).Value

On Error Resume Next

'Loop through each cell in column 14 to check if value is 1 or 0, send email if 1

If Sheet1.Cells(i, 14).Value = 1 Then

'Send mail to recipient with the following information
With OutMail
'.To = ""
'.CC = ""
.BCC = RecipientEmail
.Subject = AgmtNum + " " + "Deliverable Auto-Reminder"
.Body = "Insert body here"
'.Attachments.Add ActiveWorkbook.FullName
.Send   'or use .Display
End With
On Error GoTo 0
End If

'Increment i for looping, wait at least 10 seconds before sending next email
Application.Wait (Now + TimeValue("0:00:10"))
Next i

'Clean up Outmail and OutApp
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Answer 1

将Set OutMail = OutApp.CreateItem(0) 放入loop。

只发送了第一封电子邮件，因为当您尝试发送第二封电子邮件时，您实际上覆盖了第一封电子邮件，您正在编辑相同的OutMail 对象。它没有被发送，因为它已经在第一次迭代中。

For i = 26 To 29
    .
    .
    .
    If Sheet1.Cells(i, 14).Value = 1 Then
        Set OutMail = OutApp.CreateItem(0) 'Create a new mail item for every mail that has to be sent

上面的更正应该可以解决它