Excel VBA为多个To，CC和BCC撰写电子邮件

我正在尝试创build发送给多个人的单个电子邮件。 现在我有一列的电子邮件地址和右侧的“发送到”，“抄送”或“密件抄送”checkbox。

Emails address: B3 - B13 (this list will expand, i may end up using lastrow) "True/False" To: D3- D13 "True/False" CC: F3- F13 "True/False" BCC: H3- H13 Send if TRUE, skip if FALSE. 

我确信这很简单，而且我已经看了，我被卡住了。

感谢您的回复。

Answer 1

这里有一个macros应该做你想做的事情，当然这个macros是为了适应你的具体需要而调整的，因为这个问题很模糊。

请参阅评论的说明。

 Sub sendEmail() ' Set up outlook objects for emailing Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) ' Body text for the email Dim strbody As String strbody = "This text in the body of your email" ' Strings to contain the email addresses Dim sendTo As String sendTo = "" Dim sendCC As String sendCC = "" Dim sendBCC As String sendBCC = "" ' The cell containing the email address (loop variable) Dim emailCell As Range With ActiveSheet ' Cycle through email addresses, from B3 to one before next blank cell in column For Each emailCell In .Range("B3", .Range("B3").End(xlDown)) ' Check each TRUE/FALSE column in same row, add email addresses accordingly If .Cells(emailCell.Row, "D").Text = "TRUE" Then sendTo = sendTo & "; " & emailCell.Text End If If .Cells(emailCell.Row, "F").Text = "TRUE" Then sendCC = sendCC & "; " & emailCell.Text End If If .Cells(emailCell.Row, "H").Text = "TRUE" Then sendBCC = sendBCC & "; " & emailCell.Text End If Next emailCell End With ' Generate email in outlook objects defined above On Error Resume Next With OutMail .To = sendTo .CC = sendCC .BCC = sendBCC .Subject = "Subject Message Here" .HTMLBody = strbody .Display ' If you don't want to display the email before sending it, ' simply use .Send instead of .Display End With On Error GoTo 0 End Sub