循环将一封电子邮件发送到列表中固定数量的地址，直到列表结束。嵌套范围循环与数组

Question

我有一个 Excel sheet，其中一列大约有 200 个电子邮件地址。

我正在尝试创建一封在“收件人”字段中包含标准收件人的电子邮件，然后遍历这 200 个地址并将固定数量的地址放入“密件抄送”字段中，然后创建另一封邮件接下来是固定数量的地址，依此类推，直到我到达列表的末尾。

我修改了我在网上找到的以下代码来发送个人邮件：

Sub BulkMail()
Application.ScreenUpdating = False

ThisWorkbook.Activate
'Creating references to Application and MailItem Objects of Outlook
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem

'Creating variable to hold values of different items of mail
Dim sendTo, subj, atchmnt, msg, ccTo, bccTo As String

Dim lstRow As Long

ThisWorkbook.Sheets("Sheet1").Activate
'Getting last row of containing email id in column 5.
lstRow = Cells(Rows.Count, 5).End(xlUp).Row

'Variable to hold all email ids

Dim rng As Range
Set rng = Range("E2:E" & lstRow, 20)

'initializing outlook object to access its features
Set outApp = New Outlook.Application
On Error GoTo cleanup 'to handle any error during creation of object.

'Loop to iterate through each row, hold data in of email in variables and send
'mail to each email id.

For Each cell In rng
    sendTo = Range(cell.Address).Offset(0, 0).Value2
    subj = Range(cell.Address).Offset(0, 1).Value2 & "-MS"
    msg = Range(cell.Address).Offset(0, 2).Value2
    atchmnt = Range(cell.Address).Offset(0, -1).Value2
    ccTo = Range(cell.Address).Offset(0, 3).Value2
    bccTo = Range(cell.Address).Offset(0, 4).Value2

    On Error Resume Next 'to hand any error during creation of below object
    Set outMail = outApp.CreateItem(0)
    
    'Writing and sending mail in new mail
    With outMail
        .To = sendTo
        .BCC = bccTo
        .Body = "Hi this is a test"
        .Subject = "Test"
        .Attachments.Add atchmnt
        .Send 'this send mail without any notification. If you want see mail
              'before send, use .Display method.
    End With
    On Error GoTo 0 'To clean any error captured earlier
    Set outMail = Nothing 'nullifying outmail object for next mail
 Next cell 'loop ends

cleanup: 'freeing all objects created
        Set outApp = Nothing
        Application.ScreenUpdating = True
Application.ScreenUpdating = True
End Sub

我为查看是否可以修改步长而进行的搜索并没有为我提供任何有用的信息。

我知道我的范围是从第二行中的值设置到（在本例中）E 列的单元格中找到的最后一个值。

我基本上不想使用 For Each cell In rng，而是像 For every 20 cells In rng 这样的东西（最后一个显然不起作用，但它可能是一个有用的伪代码示例）。

我读到数组可能更有用，据我了解，我可以将值的范围存储在多个数组中，然后遍历数组。我想学做这个。

Answer 1

您需要替换以下代码：

For Each cell In rng
    sendTo = Range(cell.Address).Offset(0, 0).Value2
    subj = Range(cell.Address).Offset(0, 1).Value2 & "-MS"
    msg = Range(cell.Address).Offset(0, 2).Value2
    atchmnt = Range(cell.Address).Offset(0, -1).Value2
    ccTo = Range(cell.Address).Offset(0, 3).Value2
    bccTo = Range(cell.Address).Offset(0, 4).Value2

    On Error Resume Next 'to hand any error during creation of below object
    Set outMail = outApp.CreateItem(0)
    
    'Writing and sending mail in new mail
    With outMail
        .To = sendTo
        .BCC = bccTo
        .Body = "Hi this is a test"
        .Subject = "Test"
        .Attachments.Add atchmnt
        .Send 'this send mail without any notification. If you want see mail
              'before send, use .Display method.
    End With
    On Error GoTo 0 'To clean any error captured earlier
    Set outMail = Nothing 'nullifying outmail object for next mail
 Next cell 'loop ends

首先，不需要为工作表中的每一行创建一个新的邮件项目对象。因此，您需要在循环外创建一个邮件项目：

Set outMail = outApp.CreateItem(0)
sendTo = Range(cell.Address).Offset(0, 0).Value2
subj = Range(cell.Address).Offset(0, 1).Value2 & "-MS"
msg = Range(cell.Address).Offset(0, 2).Value2
atchmnt = Range(cell.Address).Offset(0, -1).Value2

Set recipients = outMail.Recipients

For Each cell In rng
    ccTo = Range(cell.Address).Offset(0, 3).Value2
    bccTo = Range(cell.Address).Offset(0, 4).Value2
    
        
        recipientTo = recipients.Add(ccTo)
        recipientTo.Type = Outlook.OlMailRecipientType.olTo
       
        recipientBCC = recipients.Add(bccTo)
        recipientBCC.Type = Outlook.OlMailRecipientType.olBCC
        
 Next cell 'loop ends
    
    recipients.ResolveAll()
    
.Body = "Hi this is a test"
.Subject = "Test"
.Attachments.Add atchmnt
.Send 'this send mail without any notification. If you want see mail

Set outMail = Nothing 'nullifying outmail object for next mail

使用 MailItem class 的 Recipients 属性添加收件人，其中包含 Outlook 项目的 Recipient 对象集合。使用 Add 方法创建一个新的 Recipient 对象并将其添加到 Recipients 对象中。新 Recipient 对象的类型属性设置为关联的 AppointmentItem、JournalItem、MailItem 或 TaskItem 对象的默认值，并且必须重置以指示另一种收件人类型。该名称可以是表示显示名称、别名、完整 SMTP 电子邮件地址或收件人手机 phone 号码的字符串。一个好的做法是将 SMTP 电子邮件地址用于邮件消息。

在 How To: Fill TO,CC and BCC fields in Outlook programmatically 文章中阅读更多相关信息。

循环将一封电子邮件发送到列表中固定数量的地址，直到列表结束。嵌套范围循环与数组

Loop to send one email to a fixed number of addresses from a list until end of list. Nested range loops vs array

excel

outlook

vba