发送电子邮件到收件人列表Excel
我想在运行报表时自动从Excel发送一个报表，但是我需要它对客户端名称执行VLOOKUP并select分配给该客户端的所有电子邮件地址。 你能帮忙吗？
所以我会在名为“ Client Emails的工作表中Client Emails如下表格
Company 1 | example@mail.com Company 1 | example2@mail.com Company 2 | somebody@somewhere.com Company 3 | you@here.com Company 1 | him@there.com
使其更容易保持最新。 现在我有下面的代码发送正确的电子邮件，但我希望它从工作簿，而不是代码的地址，因为这是更容易更新。
Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = "example@mail.com; example2@mail.com" .CC = "" .BCC = "" .Subject = "Subject" .Body = "Hello World." .Attachments.Add ("Attachment") '.Display .Send End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing
您可以设置一个循环来查看电子邮件地址表，并将匹配公司的电子邮件连接成一个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
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