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
问问题
489 次
1 回答
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 | : : |
+---------------+---------------+---------------+--- ...
在第一行您可以放置收件人,第二行是抄送,第三行是密件抄送。在第 4 行,它再次统计了收件人。现在您只需遍历表并发送邮件。
侧面的小提示:您可以Step 3
在迭代后使用将迭代器增加 3(而不是 1)。
于 2013-07-24T08:42:01.953 回答