VBA代码、自动批量发送邮箱

账务每个月发工资条给每个员工可以用这个办法一键搞定。

老师给学生布置作业也可以用这个办法轻松完成。

很多大量的工作我们在Excel里面完成后发送给领导及相关人员如果是一条条发送真是太费时间了，当人多的时候让你复制邮箱号也够让你手累眼花的。

当有了批量发送模板文件你只需要把信息内容导进去就可以了，剩下时间交给电脑你就安心刷你的视频。

实现功能：批量发送邮箱

下面是代码分享

写代码前、前期准备

上面这些都是前期准备。发送邮箱我用的是QQ邮箱发的也可以用Outlook邮箱账户发送，但是我在测试的时候没有发送成功，不知道是不是我那里没有设置对还是我申请账号的时候是申请的免费账号的问题。

下面是代码写入

Sub SendMailEnvelope()

Dim avntWage As Variant

Dim i As Long

Dim strText As String

Dim objAttach As Object

Dim strPath As String

With Application

.ScreenUpdating = False '禁用屏幕更新为了快速运行代码

.EnableEvents = False '禁用事件。启动了禁用事件下面的自动事件是不启到作用

End With

strPath = ThisWorkbook.Path & '\关于企业调整职工工资的通知.docx'

'------------邮件发送附件的路径

avntWage = Sheets('工资表').[a1].CurrentRegion

'------------工资表的数据装入数组

For i = 2 To UBound(avntWage)

[a2:i2] = Application.Index(avntWage, i)

'------------工资条数据放入a2:i2区域

[b1:i2].Select

'------------选中b1:i2作为邮件正文的表格内容

ActiveWorkbook.EnvelopeVisible = True '如果电子邮件撰写标题和信封工具栏都可见

'------------MailEnvelope可见

With ActiveSheet.MailEnvelope '表示文档的电子邮件头

strText = avntWage(i, 2) & '您好：' & vbCrLf & '以下是您' & _

avntWage(i, 3) & '月份工资明细，请查收！'

.Introduction = strText

'------------邮件正文内容

With .Item

.To = avntWage(i, 1)

'------------收件人

.CC = '[e-mail]'

'.CC = '[e-mail]'

'------------抄送人

.Subject = avntWage(i, 3) & '月份工资明细'

'------------主题

Set objAttach = .Attachments '包含一组代表 Outlook 项目中的附件

Do While objAttach.Count > 0

'------------Do While语句删除可能存在的旧附件

objAttach.Remove 1 '对象的AccessObjectProperties集合中删除

'MsgBox objAttach.Count

Loop

.Attachments.Add strPath

'------------添加新附件

.send

'------------发送邮件

End With

End With

Next i

ActiveWorkbook.EnvelopeVisible = False

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

Set objAttach = Nothing

End Sub