|
一提到批量发送邮件，可能很多小伙伴就想到Word里面的邮件合并功能，可以批量发送邮件和工资条等。还没学习过的小伙伴请移步：【Word技巧】- 教会你99%的人都不会的“邮件合并”功能。
从今天图文的标题就可以看出，是使用VBA结合Outlook进行批量邮件发送，所以在发送之前就需要先配置Outlook，配置一个可以用来发送邮件的邮箱，具体配置如下：
1 点击【文件】菜单，选择【信息】，点击【添加帐户】，进入新帐户添加向导。
2 在弹出的对话框中选择【手动设置或其他服务器类型】，点击【下一步】。
3 选择【POP或IMAP】，点击【下一步】。
4 按下图所示填入信息，然后点击【其他设置】。
5 在【其他设置】里找到【发送服务器】，选中【我的发送服务器(SMTP)要求验证】，具体如下图所示：
6 在【其他设置】里找到【高级】，具体设置如下图所示：
7 点击【确定】，回到第4步，点击【下一步】进行自动测试账户，测试成功后如下图所示：
8 此时邮箱就会收到Outlook发送的测试消息，测试邮件截图如下：
Outlook邮箱配置好了后，就可以使用如下的代码进行批量发送邮件了。使用Excel VBA批量发送的核心代码如下：
'*******************************************************************' '经测试在OUTLOOK 2000中不会显示警告窗口. '引用：Microseft Outlook *.0 Object Library '需要注意一点 , 邮件的标题, 否则不能自动放送! '********************************************************************** Public Function SendMail(strTo As String, strSubject As String, strBody As String, Optional strAttachment As String = '', Optional strCC As String = '', Optional strBCC As String = '') As Integer
On Error GoTo errHandler '定义outlook的对象变量 Dim objOutlook As New Outlook.Application '定义outlook邮件的对象变量 Dim objMail As Mailitem '创建objOutlook为Outlook应用程序对象 Set objOutlook = New Outlook.Application '创建objMail为一个邮件对象 Set objMail = objOutlook.CreateItem(olMailitem) '循环添加附件 Dim strArray strArray = Split(strAttachment, '|') For i = 0 To UBound(strArray) objMail.Attachments.Add ThisWorkbook.Path & '\' & strArray(i) '如果有多个附件，分别添加 Next objMail.To = strTo '设置收信人的邮箱 If ChkEmail(strCC) = 0 Then objMail.CC = strCC '设置抄送的邮箱 End If If ChkEmail(strBCC) = 0 Then objMail.BCC = strBCC '设置密送的邮箱 End If '设置邮件的主题 If strSubject <> '' Then objMail.Subject = strSubject Else objMail.Subject = '主题' End If '设置邮件正文 objMail.Body = strBody With objMail '新建邮件窗口显示，如果不熟练可以取消注释 '.Display '邮件发送 .Send End With '销毁objMail对象 Set objMail = Nothing '销毁objOutlook对象 Set objOutlook = Nothing SendMail = 0 Exit Function errHandler: SendMail = 1 End Function
如上所示，该代码为一个函数，创建了Outlook和邮件对象，然后进行设置收件人、主题、正文、附件等信息。代码还对邮件的邮箱使用函数ChkEmail进行正则表达式验证，具体代码如下：
'检查邮件是否规范 Function ChkEmail(str As String) Dim reg Set reg = CreateObject('vbscript.regexp') reg.Pattern = '^[\w.-] @[\w.-] $' If reg.test(str) Then ChkEmail = 0 Else ChkEmail = 1 End If End Function
如果仅仅使用上面两个自定义函数，还无法发送邮件，因为没有填充相应的内容，下图是我制作的邮件信息：
那有了邮件信息和上面两个自定义函数，该如何批量发送邮件呢？还需要定义一个过程，用来循环发送邮件，具体代码如下：
Sub 发送邮件() Dim ierr As Integer Dim iCount As Integer, iTotal As Integer Worksheets('Sheet1').Select Range('A2').Select iCount = 0 iTotal = 0 Do While ActiveCell.Value <> '' ierr = SendMail(ActiveCell.Value, ActiveCell.Offset(0, 1).Value, ActiveCell.Offset(0, 2).Value, ActiveCell.Offset(0, 3).Value, ActiveCell.Offset(0, 4).Value, ActiveCell.Offset(0, 5).Value) If ierr = 0 Then iCount = iCount 1 End If iTotal = iTotal 1 ActiveCell.Offset(1, 0).Select Loop MsgBox '共发送' & iTotal & '个，成功发送邮件' & iCount & '个！' End Sub
如上的代码还是比较好理解的，就是使用do while循环从工作表Sheet1中获取需要发送的邮件信息并发送，最后弹出一个对话框用来显示当前一共发送多少邮件，其中成功了多少，说了那么多一起来演示一下吧。
咦，为啥运行宏代码出现用户定义类型未定义错误呢？因为我们在Excel用到了Outlook的资源，所以必须先引用后才能使用，具体引用方法详见如下动态图：
经过上面的设置，接下来就开始批量发送邮件啦，具体演示如下所示：
如果运气比较好的话，就能立刻收到发送的邮件。如果没有立刻收到也不要慌张，任务已经加入到Outlook任务列表，稍等一时就会成功发送了。如果Outlook未进行任何设置，会出现下图所示的警告：
出现此警告框，是由于从外部调用Outlook发送邮件，为了安全，默认情况下会弹出该提示框，稍等几秒就可以点击允许继续发送邮件了。如果需要批量发送邮件，每次都弹出该对话框并等待几秒，那场景太难想象，所以可以通过以下方法进行设置，详见动态图：
通过上图可以看出，如果编程访问里面的防病毒软件状态为无效，则需要通过设置编程访问安全性为从不向我发出可疑活动警告（不推荐）。但如果电脑安装了防病毒软件，此时防病毒软件状态为有效，则不需设置也可以不弹出警告对话框哦。
今天的介绍就到此结束啦，其实通过Outlook发送邮件也很方便，但必须先设置好Outlook邮箱，如果平时就使用该Outlook收发邮件，那就很方便了，可以批量为员工发送工资条等等。
|
