根据单元格值通过Excel VBA发送不同的电子邮件

Question

我举办了培训师培训，并有一个电子表格，我用它来创建 PDF 出勤证书和一封电子邮件，以确认他们是否已通过培训师角色的课程。这一切都是通过 Excel VBA 完成的，我从各种 Google 搜索和 Youtube 视频中截取了它......我已经设法让它正常工作，除了我希望它根据它们是否通过来发送单独的电子邮件内容。

因此，在标有“出勤”的工作表中，我有以下表格/标题：

英格兰 [电子邮件受保护]N100P[电子邮件受保护]

课程ID	结果	标题	名字	姓氏	主题	面积	用户ID	电子邮件	文件名
N100P	尚未准备好	夫人	爱丽丝	一个	英语	1236547		N100P_AliceOne_1236547.pdf
推荐	先生	鲍勃	两个	数学	苏格兰	6548789		N100P_BobTwo_6548789.pdf

课程 ID = 单元格 A1 文件名 = 单元格 J1

在宏中我有以下内容：

Sub DraftEmailWithCerts()
Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")
Dim EItem As Object
Dim path As String
path = Worksheets("PDF").Range("J2").Value 'path to folder of PDFs to be saved
Dim RList As Range
Set RList = Worksheets("Attendance").Range("A2", Worksheets("Attendance").Range("a2").End(xlDown))
Dim R As Range

For Each R In RList
    
    Set EItem = EApp.CreateItem(0)
        With EItem
        .To = R.Offset(0, 8)
        .Subject = Worksheets("Attendance").Range("A2").Value & " " & Worksheets("PDF").Range("J3").Value & ": Outcome" 'Attendance!A2 is training course ID and PDF!J3 is name of the training
        .Attachments.Add (path & R.Offset(0, 9))
        .SentOnBehalfOfName = "[email protected]"

        If Worksheets("Attendance").Range("B2").Value = "Not Ready" Then

        .HTMLBody = "<p>Thank you for your hard work and participation at the recent training.  Unfortunately the panel has concluded that you are not ready to take up the trainer role.</p>"
        
        Else
        
        .HTMLBody = "<p>Thank you for your hard work and participation at the recent training.  The panel has recommended you to take up the trainer role, congratulations.</p>"
    
        End If

        .Display
        End With

Next R
Set EApp = Nothing
Set EItem = Nothing
End Sub

我有一个单独的宏来创建必要的 PDF，它可以工作。

我正在寻找的是宏为 Alice 发送一封“未准备好”电子邮件（因为在结果列 B 中显示“未准备好”）和为 Bob 发送一封“准备好”电子邮件（他的结果是“推荐”） ...目前它只是向每个人发送一封“未准备好”电子邮件...

我对 VBA 非常陌生，因此我们将不胜感激！

谢谢！

Answer 1

所以我会尝试更换

Dim RList As Range
Set RList = Worksheets("Attendance").Range("A2", Worksheets("Attendance").Range("a2").End(xlDown))
Dim R As Range
For Each R In RList
  '...
    .Subject = Worksheets("Attendance").Range("A2").Value & " " & Worksheets("PDF").Range("J3").Value & ": Outcome"
  '...
    If Worksheets("Attendance").Range("B2").Value = "Not Ready" Then
  '...
Next R

用类似的东西

Dim shAtt as WorkSheet
Dim r as Long
Dim rFirst as Long
Dim rLast as Long
Set shAtt = ThisWorkbook.Worksheets("Attendance")
rFirst = 2
rLast = shAtt.Range("A" & r).End(xlDown).Row
For r = rFirst to rLast
  '...
    .Subject = shAtt.Range("A" & r).Value & " " & Worksheets("PDF").Range("J3").Value & ": Outcome"
  '...
    If shAtt.Range("B" & r).Value = "Not Ready" Then
  '...
Next r