qq刷屏代码可复制_干货｜案例02期：VBA助力自动批量发送邮件（内附代码）

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 IfEnd Sub

05

扩展延伸

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

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

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

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

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