我在"publico"表上有一份经理及其客户的列表。
我需要向每个经理发送一份报告，并在电子邮件正文中发送他们的客户。
例如："ag1126ct18@teste.com"经理将从"publico"工作表中接收第 2 行和第 3 行。
该列表附在此： https://drive.google.com/file/d/1jLkrWqZY9s2Kt2vy_cIMMRAd1H5iDCzg/view?usp=sharing
我有一个功能正常的代码，它贯穿表格并向经理发送电子邮件，但如果找到经理，它每次都会发送电子邮件，如果找到同一个经理，则每次重复电子邮件。
另一个问题是我不知道如何在邮件正文中添加行。
Private Sub CommandButton2_Click() 'envia o email com registro de log
Dim dictMails As Object, k, rw
Dim OutlookApp As Object
Dim cell As Range
Dim corpodoemail As String
Dim AssuntoEmail As String
Dim contator As Integer
contador = 1
Set OutlookApp = CreateObject("Outlook.Application")
'Agrupa as linhas correlatas por destinatário do e-mail
Set dictMails = CreateObject("scripting.dictionary")
For Each cell In Sheets("publico").Range("H2:H2000").Cells
destinatario = cell.value
If Len(destinatario) = 0 Then destinatario = cell.Offset(1, 0).value
If Len(destinatario) > 0 Then
If Not dictMails.exists(destinatario) Then
Set dictMails(destinatario) = New Collection 'to hold the linked rows
End If
dictMails(destinatario).Add cell.Row 'record this row
End If
Next cell
'loop over the distinct recipients and their related rows
For Each k In dictMails.keys
Debug.Print "Recipient: " & k
'build up the email body
'corpodoemail = Sheets("CAPA").Range("F11").value & "<br><br>" & _
Sheets("CAPA").Range("F13").value & "<br><br>"
'etc etc
'add the information from the linked rows
For Each rw In dictMails(k)
Debug.Print " Row: " & rw
With Sheets("publico").Rows(rw)
corpodoemail = "<head><style>table, th, td {border: 1px solid black; border-collapse:" & _
"collapse;}</style></head><body>" & _
"<table style=""width:50%""><tr>" & _
"<th bgcolor=""#D8D8D8"">MCI</th><th bgcolor=""#D8D8D8"">PRODUTO</th>" & _
"<th bgcolor=""#D8D8D8"">DATA</th></tr><tr>" & _
"<th>" & .Cells(1).value & "</th>" & "<th>" & .Cells(2).value & "</th>" & "<th>" & .Cells(4).value & "/" & .Cells(5).value & "</th>" & _
"<th>" & .Cells(12).value & "</th>" & "<th>" & .Cells(12).value & "</th>" & "<th>" & .Cells(14).value & "/" & .Cells(55).value & "</th>"
End With
Next rw
AssuntoEmail = Sheets("CAPA").Range("F8").value
Set Email = OutlookApp.CreateItem(0)
With Email
.To = k
.subject = AssuntoEmail
.HTMLBody = corpodoemail
End With
Email.Send
Next k 'próximo gerente
End Sub
如何向每个经理发送一封电子邮件，并包括所有客户的列表？
为了更清楚：
列表中的客户端 1 和 2 属于分支 1126，经理 18，因此脚本必须发送并通过电子邮件发送工作表的第 2 行和第 3 行给所述经理。
这是我的做法。删除了代码的某些部分，因此整体方法更加明显：应该清楚需要重新添加的内容。
Private Sub CommandButton2_Click() 'envia o email com registro de log
Dim dictMails As Object, k, rw
Dim OutlookApp As Object
Dim cell As Range
Dim html As String
Set OutlookApp = CreateObject("Outlook.Application")
'start by grouping all rows related by the recipient...
Set dictMails = CreateObject("scripting.dictionary")
For Each cell In Sheets("publico").Range("H2:H2000").Cells
'recipient, or default recipient?
destinatario = cell.value
If Len(destinatario) = 0 Then destinatario = cell.Offset(1, 0).value
If Len(destinatario) > 0 Then
If Not dictMails.exists(destinatario) Then
Set dictMails(destinatario) = New Collection 'to hold the linked rows
End If
dictMails(destinatario).Add cell.Row 'record this row
End If
Next cell
'loop over the distinct recipients and their related rows
For Each k In dictMails.keys
Debug.Print "Recipient: " & k
'build up the email body
html = "<head><style>table, th, td " & _
"{border: 1px solid black; border-collapse:" & _
"collapse;}</style></head><body>"
html = html & "Here is your information:<br><br>"
'open the table
html = html & "<table style=""width:50%""><tr>" & _
"<th bgcolor=""#D8D8D8"">MCI</th><th bgcolor=""#D8D8D8"">" & _
"PRODUTO</th><th bgcolor=""#D8D8D8"">DATA</th></tr>"
'add one row for each linked row
For Each rw In dictMails(k)
Debug.Print " Row: " & rw
With Sheets("publico").Rows(rw)
html = html & "<tr><td>" & .Cells(1).value & "</td>" & _
"<td>" & .Cells(2).value & "</td>" & _
"<td>" & .Cells(4).value & "/" & .Cells(5).value & "</td>" & _
"<td>" & .Cells(12).value & "</td>" & _
"<td>" & .Cells(12).value & "</td>" & _
"<td>" & .Cells(14).value & "/" & .Cells(55).value & "</td></tr>"
End With
Next rw
html = html & "</table></body></html>" '<< close the mail
'send the mail for this recipient....
Next k 'next recipient
End Sub