Vba 向收件人列表Excel发送电子邮件

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

因此，我将在名为

客户电子邮件

 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

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

例如（在with语句之前插入）：

您可以将上面的“Company1”替换为您当前发送电子邮件的公司的名称

现有代码中的替换：

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

与

company=cells（1,2）”指定公司名称的源单元格值，如VLOOKUP reference
a=2
“当单元格（a，1）”时执行此操作
如果公司=单元格（a，1），则tolist=单元格（a，2）'如果条件匹配，则邮件列表将分配给tolist
a=a+1
环
Set-OutApp=CreateObject（“Outlook.Application”）
Set-OutMail=OutApp.CreateItem（0）
发邮件
.To=tolist
.CC=“”
.BCC=“”
.Subject=“Subject”
.Body=“你好，世界。”
.Attachments.Add（“附件”）
"展示,
.发送
以
错误转到0
发送邮件=无
设置应用程序=无
如果您向公司发送邮件，您希望如何处理可能存在的多个电子邮件地址？您是否打算将一个用于to:，然后将其余部分抄送和/或密件抄送？如果您只发送到一个地址，那么是哪一个？我将向业务下的所有地址发送
，因为我们只有客户特别要求的几个地址谢谢！我得到了一个
编译错误：
，上面说
下一步没有For
。我在
Next Myrange
上面的行中添加了一个
End If
，它成功了！欢呼声修正了答案。
.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