基于单元格值通过Excel VBA发送不同邮件的问题修正

我在开展讲师培训项目时，通过Excel VBA生成PDF出勤证书并发送课程结果确认邮件，告知学员是否可担任讲师。现有代码期望根据「Attendance」工作表Outcome列的单元格值（Not Ready/Recommend）发送不同内容的邮件，但当前所有学员均收到「未就绪」邮件，需修正代码实现需求。

「Attendance」工作表结构 #

错误原因 #

现有代码的核心问题是判断条件固定引用了B2单元格：循环遍历每个学员时，始终用第一行学员（Alice）的Outcome值（Not Ready）做判断，导致所有邮件都进入「未就绪」分支。同时Subject中的CourseID也固定引用A2，会导致所有邮件的课程ID都是第一个学员的，需要一并修正。

修正后的代码 #

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 ' PDF文件存放路径
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) ' 当前行的Email列（第9列）
        ' 修正：用当前行的CourseID，而非固定A2
        .Subject = R.Value & " " & Worksheets("PDF").Range("J3").Value & ": Outcome"
        .Attachments.Add (path & R.Offset(0, 9)) ' 当前行的Filename列（第10列）
        .SentOnBehalfOfName = "train@the.trainer.com"

        ' 修正：用当前行的Outcome值做判断（R是A列，偏移1列到B列）
        If R.Offset(0, 1).Value = "Not Ready" Then
            .HTMLBody = "<p>感谢你参与本次培训并付出的努力。遗憾的是，评审组认为你目前尚未准备好担任讲师职务。</p>"
        Else
            .HTMLBody = "<p>感谢你参与本次培训并付出的努力。评审组已推荐你担任讲师职务，恭喜你！</p>"
        End If

        .Display
    End With

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

关键修改点 #

• 将判断条件Worksheets("Attendance").Range("B2").Value改为R.Offset(0,1).Value，确保每次循环都读取当前学员行的Outcome值
• 将Subject中的Worksheets("Attendance").Range("A2").Value改为R.Value，确保邮件主题使用当前学员的课程ID

内容的提问来源于stack exchange，提问作者Jake Lee