要求循环通过excel发送邮件

时间:2013-07-24 07:32:47

标签: vba

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

1 个答案:

答案 0 :(得分:0)

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


至于您的问题,您是否尝试在列中编写每个收件人,循环遍历表格然后发送邮件?

表格看起来有点像这样:

          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 |               :               :               |
  +---------------+---------------+---------------+--- ...

在第一行中您可以放置​​收件人,在第二行中放置CC,在第三行放置BCC。而在第4行,它与收件人的统计数据一遍又一遍。现在你只需循环遍历表并发送邮件。


方面的一点提示:在迭代后,您可以使用Step 3将迭代器增加3(而不是1)。