我想在运行报告时自动从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
答案 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