excel中群发邮件（含附件）代码

乐乐2006201506

Sub sendmail()
'要能正确发送并需要对MicroseftOutlook进行有效配置
On Error Resume Next
Dim rowCount, endRowNo
Dim objOutlook As New Outlook.Application
Dim objMail As MailItem
'取得当前工作表与Cells(1,1)相连的数据区行数
endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
'创建 objOutlook为Outlook应用程序对象
Set objOutlook = New Outlook.Application
'开始循环发送电子邮件，比如从第二行开始，第一行是标题
   For rowCount = 2 To endRowNo
'创建objMail为一个邮件对象
Set objMail = objOutlook.CreateItem(olMailItem)
        With objMail
'设置收件人地址（比如从 Excel表的第一列 "E" - mail地址 "字段中获得）"
   .To = Cells(rowCount, 1).Value      '"fantasia@sina.com"
'设置邮件主题（比如从Excel表的第二列"邮件主题"字段中获得）
.subject = Cells(rowCount, 2).Value      '"邮件主题"
  '设置邮件内容（比如从Excel表的第三列"邮件内容"字段中获得）
    .body = Cells(rowCount, 3).Value      '"邮件内容"
    '设置附件（比如从Excel表的第四列"附件"字段中获得）
    .Attachments.Add Cells(rowCount, 4).Value     '"c:\\users.ctl"
    .Send
    End With
        '销毁objMail对象
        Set objMail = Nothing
      Next
        '销毁objOutlook对象
       Set objOutlook = Nothing
       '所有电子邮件发送完成时提示
     MsgBox rowCount - 2 & "个员工的工资单发送成功！"
End Sub

乐乐2006201506

前段时间求助一对一群发代码，未果，最后自己钻研，通过Microsoft office outlook和邮箱关联，达到了目的，和大家分享，望对需要者有帮助，同时希望加为精华帖。