vba - 需要循环通过 excel 发送邮件

Question

Sub Mail_ActiveSheet()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim Cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim cc As String
    Dim bcc As String
    Dim Body As String
    Dim Attment As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim X As String

    X = Range("B2").Select
    Do Until ActiveCell = ""
    company = ActiveCell
    ActiveCell.Offset(0, 1).Range("A1").Select
    i = ActiveCell
    ActiveCell.Offset(0, 2).Range("A1").Select
    cemail = ActiveCell
    ActiveCell.Offset(1, -3).Range("A1").Select
    EmailAddr = Range("L2")
    cc = Range("M2")
    bcc = Range("N2")
    Subj = Range("O2")
    Attment = Range("P2")
    Body = "Dear All," & vbLf _
    & vbLf _
    & "Request you to present the ECS as per the below details & Pl confirm after submission of the data file.  " & vbLf _
    & vbLf _
    & "CECS handover date                 :" & Range("I2") & vbLf _
    & vbLf _
    & "Settlement Date                       :" & Range("J2") & vbLf _
    & vbLf _
    & "Number of records                    :" & Range("F2") & vbLf _
    & vbLf _
    & "Total Contra Amount                 : " & Range("G2") & vbLf _
    & vbLf _
    & "Type of presentation                  : ECS Debit" & vbLf _
    & vbLf _
    & "Attachments                              : E-2 Form/Validation Reports/ECS data file" & vbLf _
    & vbLf _
    & "Thanks & Regards" & vbLf _
    & vbLf _
    & "GOBI L" & vbLf _
    & "ING VYSYA BANK LTD | CECS | 100, EDEN PARK | 20 VITTAL MALLYA ROAD | BANGALORE-560001 | PH :080-22532127 | "

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook
    Set Destwb = ActiveWorkbook

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .To = EmailAddr
            .cc = cc
            .bcc = bcc
            .Subject = Subj
            .Body = Body
            .Attachments.Add (Attment)
            .Display
        End With
        Loop

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Answer 1

请阅读并遵守规则，并仔细查看提供的链接。

---

至于您的问题，您是否尝试过将每个收件人写在一列中，遍历表格然后发送邮件？

该表可能看起来像这样：

          A               B               C              
  +---------------+---------------+---------------+--- ...
1 | r1@foo.bar    : r2@foo.bar    : r3@foo.bar    |
2 | cc1@bar.foo   : cc2@bar.foo   : cc3@bar.foo   |
3 | bcc1@far.boo  : bcc2@far.boo  :               |
  +---------------+---------------+---------------+--- ...
4 | rr4@foo.bar   :               :               |
5 | cc4@bar.foo   : cc5@bar.foo   :               |
6 |               :               :               |
  +---------------+---------------+---------------+--- ...

在第一行您可以放置​​收件人，第二行是抄送，第三行是密件抄送。在第 4 行，它再次统计了收件人。现在您只需遍历表并发送邮件。

---

侧面的小提示：您可以Step 3在迭代后使用将迭代器增加 3（而不是 1）。