我有下面的代码，它的工作原理，几乎完美。请看样本数据。该代码沿着A列中的名称向下，并为每个唯一名称创建一个电子邮件，将相应的名称作为列表放置在E列中。它继续到A中的下一个唯一名称，直到完成。
我的问题是，当我打了一个人与相同的第一个名字，突出显示。它是取A中的第一个名字，并将E中的所有名字都放在那个人下面，但它们应该分开。我试着将其设置为全名，但这导致了一个疯狂的循环，它只是不断创建电子邮件...这将是罚款，如果只是显示。但是如果我把它设置为发送，它就会出错，说有一个项目被删除了。
如何正确调整此代码，以便为A列中的每个唯一名称创建一封电子邮件？谢谢你。

Sub TEST()
'
'
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim strname As String
Dim strEmp As String
Dim previousName As String
Dim nextName As String

Dim emailWS As Worksheet
Dim nameCol As Double
Dim empCol As Double
Dim lastCol As Double
Dim lastRow As Double
Dim startRow As Double
Dim startCol As Double
Dim r As Double

Dim empList As String

sigstring = Environ("appdata") & _
            "\Microsoft\Signatures\work.htm"
                          
    If Dir(sigstring) <> "" Then
     signature = GetBoiler(sigstring)
     Else
     signature = ""
    End If

empList = ""
previousName = ""
nextName = ""

Set OutApp = CreateObject("Outlook.Application")

Set emailWS = ActiveSheet
startRow = 1
startCol = 1
nameCol = 1
empCol = 5

lastRow = emailWS.Cells(emailWS.Rows.Count, nameCol).End(xlUp).Row

lastCol = emailWS.Cells(1, emailWS.Columns.Count).End(xlToLeft).Column

emailWS.Range(Cells(startRow, startCol), Cells(lastRow, lastCol)).Sort key1:=emailWS.Range(Cells(startRow, nameCol), Cells(lastRow, nameCol))

For r = startRow To lastRow
    strname = Trim(Split(emailWS.Cells(r, nameCol), ",")(1))
    strEmp = emailWS.Cells(r, empCol)
    
    If emailWS.Cells(r + 1, nameCol) <> "" Then
      
       nextName = Trim(Split(emailWS.Cells(r + 1, nameCol), ",")(1))
      
       nextName = "Exit"
    End If

    If strname <> previousName Then
        
        previousName = strname
        
        Set OutMail = OutApp.CreateItem(0)
        
        With OutMail
            .To = emailWS.Cells(r, 2).Value
            .Subject = "Low Balance "
            empList = strEmp & "<br>"
            strbody = "<Font Face=calibri>Dear " & strname & ", <br><br> As of the last pay     period, the below are at a low balance."
            
        End With
    Else

If InStr(empList, strEmp) = 0 Then
    
    empList = empList & strEmp & "<br>"
Else
   
End If
End If
    If strname <> nextName Then
        OutMail.HTMLBody = strbody & "<B>" & empList & "</B>" & "<br>" & signature
        OutMail.Display
    Else
    End If
Next r

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.ReadAll
ts.Close
End Function

编辑：这是我把它设置为发送而不是显示时得到的错误。它只发送前3封电子邮件，第3封只包括名字。