☰

使用 Excel VBA 发送批量邮件

tag-icon • tag-icon vba microsoft-excel-2013 macros
使用 Excel VBA 发送批量邮件

正在进行一个项目，如果满足条件，该项目将向不同的人发送批量邮件。

状况 ：

  • 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指的是什么，但你明白要点。

相关内容