Excel 2013 VBA 多个电子邮件地址到 Outlook

Question

我在 Excel 2013 年编码。我有 table 的客户数据，的数量会随着时间的推移而增加和减少 取决于我活跃的退伍军人案件量：

A 列 - 姓氏
B 列 - 名字
C 列 - 电子邮件地址
D 列 - 等等...

我需要代码来引用 C 列并将其中的所有电子邮件放入单个 Outlook 电子邮件的密件抄送中。我创建的代码（通过我的研究）只允许将电子邮件地址硬编码到 Outlook 的 TO、CC 或 BCC 字段——多个条目之间有一个分号。我的问题是电子邮件地址的数量会根据电子表格中记录的数量而变化，因此对它们进行硬编码是没有用的。除了电子邮件问题之外，下面的代码具有我需要的所有功能。

Sub SendBasicEmail()
Dim olApp As Outlook.Application
Dim olEmail As Outlook.MailItem
Set olApp = New Outlook.Application
Set olEmail = olApp.CreateItem(olMailItem)
With olEmail
    .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "<h3>Testing</h3><br>" & "<br>" & .HTMLBody
    .Attachments.Add "xxx/test.pdf"
    .To = ""
    .BCC = ""
    .Subject = "Test Message"
    '.Send
End With 
End Sub

Answer 1

代码将循环遍历 sheet 1 的内容（只需更改为 sheet("whateveryoucalledyoursheet")）并保留单元格行。

Sub SendBasicEmail()
dim ws as worksheet, y
Dim olApp As Outlook.Application
Dim olEmail As Outlook.MailItem
set ws = sheets(1)
for each y in ws.range("A1:A" & ws.range("A1").SpecialCells(xlCellTypeLastCell).row)

Set olApp = New Outlook.Application
Set olEmail = olApp.CreateItem(olMailItem)
With olEmail
    .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "<h3>Testing</h3><br>" & "<br>" & .HTMLBody
    .Attachments.Add "xxx/test.pdf"
    .To = ws.range("A" & y.row)
    .BCC = ws.range("C" & y.row)
    .Subject = "Test Message"
    ' use display to check the email out before you send
    .display
    '.Send
End With
next y

end sub

Answer 2

我只是循环遍历该列并生成包含用分号分隔的地址的字符串。

Sub SendBasicEmail()
Dim olApp As Outlook.Application
Dim olEmail As Outlook.MailItem
Set olApp = New Outlook.Application
Set olEmail = olApp.CreateItem(olMailItem)

'set your range as needed, i chose one named "recipients"
bc_r = ""
For each cl in range("recipients")
    bc_r = bc_r & "; " & cl.Value
Next cl

With olEmail
    .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "<h3>Testing</h3><br>" & "<br>" & .HTMLBody
    .Attachments.Add "xxx/test.pdf"
    .To = ""
    .BCC = bc_r
    .Subject = "Test Message"
    '.Send
End With
End Sub

Excel 2013 VBA 多个电子邮件地址到 Outlook

Excel 2013 VBA multiple email addresses to Outlook

email

excel

outlook

vba

excel-2013