01
使用背景
1、VBA简介
VBA作为一种宏语言，在Excel、Word、PPT等软件中可Alt+F11一键开启编写。免去主流编程语言（如大热的Python）安装时的复杂与痛苦，像傻瓜一样复制代码进去即可立刻运行。堪称解放办公室一族的最佳利器！
2、应用领域
财务（报表、对账单）、法务（合同）、招投标（清标、报告）、日常办公（打印、批量调整格式、批量发送邮件、爬取网页数据）等等各方面涉及Office软件的自动化操作。
3、本文目标解决
编程小白人群的日常办公——自动（批量）发送邮件。
文末扩展阅读适用进阶玩家~
02
实现效果
无需打开网页邮箱或客户端即可自动（批量）发送邮件，仅在后文的代码中简单修改即可实现。若想实现批量发送不同收件邮箱/主题/内容等，可参考文末扩展延伸。
可实现自动发送如下图邮件的效果：
03
具体步骤
1、打开发送邮箱（本例为163邮箱）设置，开启POP3/SMTP服务；
2、打开发送邮箱（本例为163邮箱）设置，新增授权密码并复制出来存好；
3、新建一个Excel文档，按下Alt+F11打开VBA窗口，将后附的代码复制进去；
4、将你需要的信息替换，包括上面取得的第三方邮件客户端的专用密码，再按F5快捷键，即可自动发送邮件。
04
代码说明
代码前半部分设置收发邮件的信息，后半段设置CDO及检验是否发送成功；
请注意代码后面的注释，并根据其提示对应修改。
代码如下：
Private Sub Command1_Click()
Dim CDO As Object
Const Email_From = "[email protected]" '修改为发送邮箱
Const Password = "第三方邮件客户端的专用密码" '修改为第三方邮件客户端的专用密码
Const Email_To = "[email protected]" '修改为收件邮箱
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，而不是[email protected]
.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
05
扩展延伸
目前实现的是单一邮件的自动发送。如果想改成批量发送给不同收取邮箱、主题、正文、附件等内容，需要将上面代码中的收取邮箱、邮件主题、邮件正文、邮件附件修改为变量，定位到下图中对应的单元格，然后写一个循环，即可按Excel表中的内容批量发送。
亲测可用于企业邮箱，但记得将smtpserver修改为smtp.exmail.qq.com即可。
有什么想法或建议欢迎留言，可以定制代码噢~
关注Gavin与狗，让你解放双手！
拒绝白瞟，从分享/点赞/在看三连做起