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

时间:2014-09-18 12:17:11

标签: excel vba email excel-vba excel-2007

我想在运行报告时自动从Excel发送,但我需要它在客户端名称上执行VLOOKUP并选择分配给该客户端的所有电子邮件地址。你能帮忙吗?

所以我会在名为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

2 个答案:

答案 0 :(得分:1)

您可以设置一个循环来查看电子邮件地址表,并将匹配公司的电子邮件连接到一个字符串变量中,然后将其用于"到"部分。

例如(在你的with语句之前插入):

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

您将替换" Company1"在上面是您当前通过电子邮件发送的公司的名称。

现有代码替换:

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

.To = myEmail

答案 1 :(得分:0)

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