自动电子邮件与身体的变化 – VBA

我必须创build一个VBA来发送自动电子邮件（电子邮件的主体将收件人链接到他负责的特定项目）。 我遇到的问题是，某个收件人（即“收件人”）可以负责更多的任务。 我正在使用的VBA将电子邮件发送到每个任务（即使该人负责更多）。 如果发送包含所有任务的电子邮件大于1，我可以通过收件人进行计数。 我真的需要你的帮助。

<PRE>Sub SendEMail() Dim OutApp As Object Dim OutMail As Object Dim lastRow As Long Dim Ebody As String lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row For i = 2 To lastRow Ebody = "<FONT SIZE = 4 name = Arial>" & "Dear " & Cells(i, "A").Value & "<br>" _ & "<br>" _ & "Please note that the below mentioned projectd are in scope for reporting." & "<br>" _ & "<br>" _ & Cells(i, "C").Value & " - " & Cells(i, "E").Value & "<br>" _ & "xxxxx will investigate and action your notification according to priority and to ensure public safety." & "<br>" _ & "For further information, please phone xxxxx on 6111 and quote reference number:" & "<br>" _ & "Your original report can be seen below:" & "</Font>" & "<br>" _ Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = Cells(i, "B").Value .Cc = Cells(i, "D").Value .Subject = "Your Registration Code" .HtmlBody = Ebody .Attachments.Add "C:\Test\Document.docx" .Attachments.Add "C:\Test\Document1.docx" .SentOnBehalfOfName = "[e-mail]" .Display End With Next End Sub </pre> 

Answer 1

 Sub Emailer() Dim OutApp As Object Dim OutMail As Object Dim cell As Range, y, sbody Dim eml As Worksheet, bd As Worksheet Dim underlyingary, ISINarray, Accountarray, i Set eml = Sheets("Emailer"): Set bd = Sheets("Body"): Set OutApp = CreateObject("Outlook.Application") For Each y In eml.Range("A2:A" & eml.Range("A1000000").End(xlUp).Row) If eml.Range("F" & y.Row) <> "" Then underlyingary = Split(eml.Range("F" & y.Row), ",") Accountarray = Split(eml.Range("G" & y.Row), ",") ISINarray = Split(eml.Range("H" & y.Row), ",") For i = 0 To UBound(underlyingary) sbody = sbody & vbNewLine & "Underlying: " & WorksheetFunction.Proper(Trim(underlyingary(i))) & " Account Number: " & WorksheetFunction.Proper(Trim(Accountarray(i))) & " ISIN: " & WorksheetFunction.Proper(Trim(ISINarray(i))) & "<br>" & "<br>" Next i Else sbody = sbody & vbNewLine & "Underlying: " & WorksheetFunction.Proper(Trim(eml.Range("C" & y.Row))) & " Account Number: " & WorksheetFunction.Proper(Trim(eml.Range("D" & y.Row))) & " ISIN: " & WorksheetFunction.Proper(Trim(eml.Range("E" & y.Row))) & "<br>" End If On Error GoTo cleanup Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = eml.Range("A" & y.Row) .Subject = bd.Range("B2") .cc = eml.Range("I" & y.Row) .htmlBody = bd.Range("A2") _ & "<br>" & "<br>" & _ bd.Range("A3") & _ Trim(eml.Range("B" & y.Row)) & _ bd.Range("A4") _ & "<br>" & "<br>" & _ sbody _ & "<br>" & _ bd.Range("A5") _ & "<br>" & "<br>" & "<li>" & _ bd.Range("A6").Text & "</li>" & _ "<br>" & "<br>" & "<li>" & _ bd.Range("A7").Text & "</li>" & _ "<br>" & "<br>" & "<li>" & _ bd.Range("A8").Text & "</li>" & _ "<br>" & "<br>" & _ bd.Range("A9") _ & "<br>" & bd.Range("A10") .display End With On Error GoTo 0 Set OutMail = Nothing Next y cleanup: Set OutApp = Nothing End Sub