Sending Emails to unique people from a column

问题

I have a TABLE with list of people and their names and a condition(Y/N) column.

Column 1    Column 2    Column 3 
 (Name)      (Email)  (Condition Y/N) 

I want to send emails to all people in the TABLE whose name matches with the unique values (name) in one of the columns in Sheet 1.

So I want something that looks up the column in Sheet 1 and maybe changes the Condition to Y (in Column 3) in the TABLE, for all unique names found in that Column (Column D) in Sheet 1.(I can FILTER my TABLE in POWER QUERY to show only the rows with Condition "Y").

When the SINGLE email pops up (with the all people in the "To",) I want Sheet 1 or Sheet 2 to be attached to the email. This is already done.

I have a Macro 1 which runs and generates a new sheet called "Sheet 1".

My 2nd Macro works the way below. It displays the Outlook This works to generate an outlook pop up with attached file. I want it to only add the people which have "Y" in Column 3 . But Column D in "Sheet 1" has the list of people who didn't comply for various tasks. Now using this column I want to change the Condition to "Y" or "N" in Column 3 for all the unique names found in column D of the "Sheet 1". Please note that the "Sheet 1" will be generated every-time I run Macro 1. I'm thinking of doing a if error(vlookup......). Do you think it will work?Is it the best way? What do you recommend?

Please see the code for Macro 2.

Option Explicit

Public Sub SendEmail()
    ' For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    ' Working in Office 2000-2016
    ' Attachment code based on: http://www.vbaexpress.com/kb/getarticle.php?kb_id=326
    ' Adapted by Ricardo Diaz ricardodiaz.co
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sourceTable As ListObject
    Dim evalRow As ListRow

    Dim newBook As Workbook
    Dim newBookName As String

    Dim counter As Long
    Dim toArray() As Variant

    Application.ScreenUpdating = False

    Set OutApp = CreateObject("Outlook.Application")

    Set sourceTable = Range("Table6_2").ListObject

    On Error GoTo Cleanup

    ' Save current file to temp folder (delete first if exists)
    ThisWorkbook.Worksheets("Sheet 1").Copy
    Set newBook = ActiveWorkbook
    newBookName = "AttachedSheet.xlsx"
    On Error Resume Next
    Kill Environ("temp") & newBookName
    On Error GoTo 0
    Application.DisplayAlerts = False
    newBook.SaveAs Environ("temp1") & newBookName
    Application.DisplayAlerts = True

    ' Loop through each table's rows
    For Each evalRow In sourceTable.ListRows

        If evalRow.Range.Cells(, 2).Value Like "?*@?*.?*" And LCase(evalRow.Range.Cells(, 3).Value) = "yes" Then
            ReDim Preserve toArray(counter)
            toArray(counter) = evalRow.Range.Cells(, 2).Value
            counter = counter + 1
        End If

    Next evalRow

    ' Setup the email
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        ' Add gathered recipients
        For counter = 0 To UBound(toArray)
            .Recipients.Add (toArray(counter))
        Next counter

        .Subject = "Reminder"

        .Body = "Dear All" _
                & vbNewLine & vbNewLine & _
                "Please comply with your tasks in the attached file " & _
                "and let us know if you have any questions."

        'You can add files also like this
        .Attachments.Add newBook.FullName ' -> Adjust this path

        .Display ' -> Or use Display
    End With

    Set OutMail = Nothing

Cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

来源：https://stackoverflow.com/questions/59952034/sending-emails-to-unique-people-from-a-column