玖叶教程网

在日常工作中，经常需要发送大量相似的邮件，比如通知、报告等等。手动发送不仅耗时，而且容易出错。VBA提供了一种自动化解决方案，让批量发送邮件变得简单高效。

一、开启邮箱SMTP服务，获取授权码；

以163邮箱为例，登录邮箱--设置--POP3/SMTP/IMAP--开启服务，根据提示获取授权码；

注意：授权码只显示一次，点击确认前需要复制记录保存下来。

二、Excel制作收件人列表，如收件人名称、邮箱、邮件的主题、正文、附件的路径等。

三、VBA代码，打开VBA编辑器，创建一个新的模块，录入代码并运行。

Sub SendEmail()
    Dim CDO As Object, ir As Long, i As Long
    Dim CDO_toname As String, CDO_to As String, CDO_subject As String
    Dim CDO_textbody As String, CDO_attachment As String

    Const Email_From = "******@163.com"
    Const Password = "*********"
    Const schema = "http://schemas.microsoft.com/cdo/configuration/"

    ir = Sheet1.UsedRange.Rows.Count

    For i = 2 To ir
        CDO_toname = Sheet1.Range("B" & i)
        CDO_to = Sheet1.Range("C" & i)
        CDO_subject = Sheet1.Range("D" & i)
        CDO_textbody = Sheet1.Range("E" & i)
        CDO_attachment = Sheet1.Range("F" & i)

        Set CDO = CreateObject("CDO.Message")

        CDO.From = Email_From
        CDO.To = CDO_to
        CDO.Subject = CDO_subject
        CDO.TextBody = CDO_textbody
        CDO.AddAttachment Trim(CDO_attachment)

        With CDO.Configuration.Fields
            .Item(schema & "sendusing") = 2
            .Item(schema & "smtpserver") = "smtp.163.com"
            .Item(schema & "smtpauthenticate") = 1
            .Item(schema & "sendusername") = Email_From
            .Item(schema & "sendpassword") = Password
            .Item(schema & "smtpserverport") = 465
            .Item(schema & "smtpusessl") = True
            .Item(schema & "smtpconnectiontimeout") = 60
            .Update
        End With

        CDO.Send
        Set CDO = Nothing
    Next i

End Sub