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

上面的修正应该解决它

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

1 个答案: