Excel VBA 通过outlook批量发邮件( 带有附件)

1、启用excel宏

2、打开开发工具

3、插入按钮

4、打开VBA

1：按住Alt键 加 F11键

或

2：在开发工具中点击“Visual Basic”

5、输入VBA代码：

Private Sub 按钮1_Click() '对按钮进行编程 复制下面的代码

'要能正确发送并需要对Microseft　Outlook进行有效配置

On Error Resume Next

Dim rowCount, endRowNo

Dim objOutlook As New Outlook.Application

Dim objMail As MailItem

Dim Signature As String

'取得当前工作表与Cells(1,1)相连的数据区行数

endRowNo = Application.WorksheetFunction.CountIfs(Range("A:A"), "<>")

'创建objOutlook为Outlook应用程序对象

Set objOutlook = New Outlook.Application

'开始循环发送电子邮件，比如从第二行开始，第一行是标题

For rowCount = 2 To endRowNo

Set objMail = objOutlook.CreateItem(olMailItem) '创建objMail为一个邮件对象

Body = "<H3><B>你好：</B></H3>" & _

              "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX<br>" & _

              "<br><br><B></B>" & _

              GetSignature()

With objMail

.To = Cells(rowCount, 1).Value '设置收件人地址（从Excel表的第一列"邮件地址"字段中获得）

.CC = Cells(rowCount, 2).Value '设置抄送人地址（从Excel表的第二列"邮件地址"字段中获得）

.Subject = Cells(rowCount, 3).Value & Year(Now) & "年" & Month(Now) & "月" '设置邮件主题（从Excel表的第三列"邮件主题"字段中获得）并记录年月

.HTMLBody = Body

'.HTMLBody = Cells(rowCount, 4).Value '设置邮件内容（从Excel表的第四列"邮件内容"字段中获得）

.Attachments.Add Cells(rowCount, 5).Value '设置附件（从Excel表的第五列"附件"字段中获得）

.Send

End With

Set objMail = Nothing '销毁objMail对象

Next

MsgBox ("邮件全部发送完成！")

Set objOutlook = Nothing '销毁objOutlook对象

End Sub

'提取邮件签名子函数

Public Function GetSignature()

Dim fso As Object

Set fso = CreateObject("Scripting.FileSystemObject")

SigPath = "C:\Users\xxxxx\AppData\Roaming\Microsoft\Signatures\IT.htm"

Set f_SignatureObj = fso.OpenTextFile(SigPath, 1, False, 0)

GetSignature = f_SignatureObj.ReadAll

f_SignatureObj.Close

Set fso = Nothing

End Function

6、设置excel

第一列是收件人邮箱：可以用分号，添加多个联系人

第二列是抄送者邮箱：

第三列是邮件主题

第四列是邮件内容

第五列是附件链接，请插入相应文件的链接

7、输入好后，点击按钮，批量发送邮件