发送电子邮件到收件人列表Excel

我想在运行报表时自动从Excel发送一个报表，但是我需要它对客户端名称执行VLOOKUP并select分配给该客户端的所有电子邮件地址。 你能帮忙吗？

所以我会在名为“ Client Emails的工作表中Client Emails如下表格

  Company 1 | [e-mail] Company 1 | [e-mail] Company 2 | [e-mail] Company 3 | [e-mail] Company 1 | [e-mail] 

使其更容易保持最新。 现在我有下面的代码发送正确的电子邮件，但我希望它从工作簿，而不是代码的地址，因为这是更容易更新。

  Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = "[e-mail]; [e-mail]" .CC = "" .BCC = "" .Subject = "Subject" .Body = "Hello World." .Attachments.Add ("Attachment") '.Display .Send End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing 

Answer 1

您可以设置一个循环来查看电子邮件地址表，并将匹配公司的电子邮件连接成一个stringvariables，然后将其用于“到”部分。

例如（在您的声明之前插入）：

 Dim Lastrow as long dim myemail as string dim myrange as Range 'counts the number of rows in use lastrow = Sheets("Client Emails").Cells(Rows.Count, 1).End(xlUp).Row For Each myrange In Sheets("Client Emails").Range("A2:A" & lastrow) If myrange = "Company1" then myEmail = myEmail & myrange.offset(0,1).value & ";" End if Next Myrange 

您将在上面replace“Company1”作为您当前正在发送电子邮件的公司的名称。

在您现有的代码取代：

 .To = Email1, Email2,email3, ......... 

同

 .To = myEmail 

Answer 2

 company = cells(1,2) ' Assign the source cell value of company name like VLOOKUP reference a = 2 do while cells(a,1)<>"" if company = cells(a,1) then tolist = cells(a,2) 'IF condition matches, To mail list will be assigned to tolist a = a +1 loop Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = tolist .CC = "" .BCC = "" .Subject = "Subject" .Body = "Hello World." .Attachments.Add ("Attachment") '.Display .Send End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing