![使用 Excel VBA 发送批量邮件](https://linux22.com/image/1497611/%E4%BD%BF%E7%94%A8%20Excel%20VBA%20%E5%8F%91%E9%80%81%E6%89%B9%E9%87%8F%E9%82%AE%E4%BB%B6.png)
正在进行一个项目,如果满足条件,该项目将向不同的人发送批量邮件。
状况 :
- U 列包含最终状态(打开或 WIP)(如果已关闭则不会发送,无论当前日期是否较大)
- Q 列包含关闭日期。与当前日期相比,如果小于则自动向人们发送邮件。
我曾尝试使用 for 循环,但它会发送 4 封具有相同收件人和抄送的邮件。并且不会转到下一行进行比较。
单元格 V2 与 Q2 进行比较,然后下一个循环 V3 与 Q3,同时检查单元格 U2 是否为“打开”
先感谢您。
代码如下:
Sub Data_RoundedRectangle1_Click()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim StrBody As String
On Error Resume Next
For i = 1 to 4
If Sheets("Data").Range("U2:U6").Value2 = "Open" Or Sheets("Data").Range("U2:U6").Value2 = "WIP" And (CDate(Cells(2, 17).Value) < Now()) Then
Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a fixed range if you want
Set rng = Sheets("Checklist").Range("A2:B25").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
If Worksheets("Data").Cells(i, "C").Value2 = "Operation_Support" And Worksheets("Data").Cells(i, "E").Value2 = "Quality_Assurance" Then
StrBody = "Hi," & "<br>" & _
.To = "a"
.CC = "b"
.BCC = ""
.Subject = ""
.HTMLBody = StrBody & RangetoHTML(rng)
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
.Display
'.Send
ElseIf Worksheets("Data").Cells(i, "C").Value = "Operation_Support" And Worksheets("Data").Cells(i, "E").Value = "Analytics" Then
StrBody = "Hi," & "<br>" & _
"PFB the process details which requires your attention." & "<br>" & _
"The review for this process has crossed over due." & "<br>" & _
"Please ask the process owner to review the Process Manuals and Maps." & "<br><br><br>"
.To = "c"
.CC = "d"
.BCC = ""
.Subject = "Process Manual and Maps Review is Overdue"
.HTMLBody = StrBody & RangetoHTML(rng)
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
.Display
'.Send
End If
End With
i = i + 1
Exit For
End If
End If
Next r
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
Next x
End Sub
答案1
我认为这是因为你的循环
For i = 1 to 4
但你从不引用i
,所以它正在做一切四次。你应该像这样使用它 -
If Sheets("Data").cells(21,1+i).Value2 = "Open" Or Sheets("Data").cells(21,1+i).Value2 = "WIP" And ...
我不完全确定你的第二部分if
指的是什么,但你明白要点。