干货｜案例02期：VBA助力自动批量发送邮件（内附代码）

使用背景

1、VBA简介

VBA作为一种宏语言，在Excel、Word、PPT等软件中可Alt+F11一键开启编写。免去主流编程语言（如大热的Python）安装时的复杂与痛苦，像傻瓜一样复制代码进去即可立刻运行。堪称解放办公室一族的最佳利器！

2、应用领域

财务（报表、对账单）、法务（合同）、招投标（清标、报告）、日常办公（打印、批量调整格式、批量发送邮件、爬取网页数据）等等各方面涉及Office软件的自动化操作。

3、本文目标解决

编程小白人群的日常办公——自动（批量）发送邮件。

文末扩展阅读适用进阶玩家~

实现效果

无需打开网页邮箱或客户端即可自动（批量）发送邮件，仅在后文的代码中简单修改即可实现。若想实现批量发送不同收件邮箱/主题/内容等，可参考文末扩展延伸。

可实现自动发送如下图邮件的效果：

具体步骤

1、打开发送邮箱（本例为163邮箱）设置，开启POP3/SMTP服务；

2、打开发送邮箱（本例为163邮箱）设置，新增授权密码并复制出来存好；

3、新建一个Excel文档，按下Alt+F11打开VBA窗口，将后附的代码复制进去；

4、将你需要的信息替换，包括上面取得的第三方邮件客户端的专用密码，再按F5快捷键，即可自动发送邮件。

代码说明

代码前半部分设置收发邮件的信息，后半段设置CDO及检验是否发送成功；

请注意代码后面的注释，并根据其提示对应修改。

代码如下：

Private Sub Command1_Click()

Dim CDO As Object

Const Email_From = "Gavin@163.com" '修改为发送邮箱

Const Password = "第三方邮件客户端的专用密码" '修改为第三方邮件客户端的专用密码

Const Email_To = "Dog@163.com" '修改为收件邮箱

Set CDO = CreateObject("CDO.Message")

CDO.Subject = "From Gavin "'邮件的主题

CDO.From = Email_From

CDO.To = Email_To

CDO.TextBody = "你好！欢迎关注Gavin与狗！"’邮件的正文内容

'CDO.AddAttachment = "C:\callmeGavin8.txt" '附件在电脑中的地址

Const schema = "http://schemas.microsoft.com/cdo/configuration/"'不用修改

With CDO.Configuration.Fields

.Item(schema & "sendusing") = 2

.Item(schema & "smtpserver") = "smtp.163.com"’如果是发送邮箱是其他邮箱需要对应修改，如为qq邮箱时：smtp.qq.com

.Item(schema & "smtpauthenticate") = 1

.Item(schema & "sendusername") = "Gavin" '注意：是Gavin，而不是Gavin@163.com

.Item(schema & "sendpassword") = "第三方邮件客户端的专用密码"'修改为第三方邮件客户端的专用密码

.Item(schema & "smtpserverport") = 465

.Item(schema & "smtpusessl") = True

.Item(schema & "smtpconnectiontimeout") = 60

.Update

End With

CDO.Send

If Err.Number <> 0 Then

MsgBox "无法发送邮件：" & Err.Description

Else

MsgBox "邮件发送成功", vbInformation

End If

End Sub

扩展延伸

目前实现的是单一邮件的自动发送。如果想改成批量发送给不同收取邮箱、主题、正文、附件等内容，需要将上面代码中的收取邮箱、邮件主题、邮件正文、邮件附件修改为变量，定位到下图中对应的单元格，然后写一个循环，即可按Excel表中的内容批量发送。

亲测可用于企业邮箱，但记得将smtpserver修改为smtp.exmail.qq.com即可。

有什么想法或建议欢迎留言，可以定制代码噢~

关注Gavin与狗，让你解放双手！

拒绝白瞟，从分享/点赞/在看三连做起