如何用VBA通过Gmail批量发送引用Excel单元格的个性化邮件

以下是适配你需求的修改后代码，可读取Excel中A列的收件人邮箱、B列的姓名，批量发送个性化邮件：

Sub Gmail_Bulk_Sending()
    Dim NewMail As CDO.Message
    Dim mailConfig As CDO.Configuration
    Dim fields As Variant
    Dim msConfigURL As String
    Dim lastRow As Long
    Dim i As Long
    On Error GoTo Err:

    ' 提前绑定CDO对象，需先引用"Microsoft CDO for Windows 2000 Library"
    Set mailConfig = New CDO.Configuration

    ' 加载默认配置
    mailConfig.Load -1
    Set fields = mailConfig.fields

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
    ' 配置Gmail SMTP参数（仅初始化一次，提升效率）
    With fields
        .Item(msConfigURL & "/smtpusessl") = True ' 启用SSL加密
        .Item(msConfigURL & "/smtpauthenticate") = 1 ' 开启SMTP身份验证
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" ' Gmail SMTP服务器地址
        .Item(msConfigURL & "/smtpserverport") = 465 ' SMTP端口（465为SSL端口）
        .Item(msConfigURL & "/sendusing") = 2 ' 通过网络发送邮件
        .Item(msConfigURL & "/sendusername") = "your_gmail_address@gmail.com" ' 替换为你的Gmail地址
        .Item(msConfigURL & "/sendpassword") = "your_app_password" ' 替换为Gmail应用密码（非原账号密码）
        .Update ' 更新配置项
    End With

    ' 获取A列最后一行的行号（确定收件人范围）
    lastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

    ' 遍历每一行发送个性化邮件
    For i = 1 To lastRow
        Set NewMail = New CDO.Message
        NewMail.Configuration = mailConfig

        With NewMail
            .From = "your_gmail_address@gmail.com" ' 发件人邮箱
            .To = ThisWorkbook.Sheets("Sheet1").Cells(i, "A").Value ' 读取当前行A列的收件人邮箱
            .CC = ""
            .BCC = ""
            .Subject = "Hello There" ' 邮件主题
            ' 拼接个性化正文：读取B列姓名并插入
            .TextBody = "您好" & ThisWorkbook.Sheets("Sheet1").Cells(i, "B").Value & "，" & vbNewLine & "我想让这段VBA代码正常工作。"
        End With

        NewMail.Send
        Set NewMail = Nothing ' 释放当前邮件对象
    Next i

    MsgBox "所有邮件已发送完成！", vbInformation

Exit_Err:
    ' 释放所有对象内存
    Set NewMail = Nothing
    Set mailConfig = Nothing
    Exit Sub

Err:
    Select Case Err.Number
        Case -2147220973 ' 网络连接异常
            MsgBox "请检查网络连接。" & vbNewLine & "错误代码：" & Err.Number & "，描述：" & Err.Description
        Case -2147220975 ' 登录凭证错误
            MsgBox "请检查Gmail登录凭证（应用密码是否正确）。" & vbNewLine & "错误代码：" & Err.Number & "，描述：" & Err.Description
        Case Else ' 其他未知错误
            MsgBox "发送邮件时遇到错误：" & vbNewLine & "错误代码：" & Err.Number & "，描述：" & Err.Description
    End Select
    Resume Exit_Err
End Sub

关键修改说明 #

1. 批量遍历逻辑：通过lastRow获取A列数据的最后一行，用For循环逐行处理收件人信息，避免重复配置SMTP参数。
2. 动态内容填充：
   • .To直接读取当前行A列的邮箱地址（Cells(i, "A").Value）
   • .TextBody通过字符串拼接，将B列的姓名（Cells(i, "B").Value）插入正文实现个性化
3. 配置复用：将Gmail的SMTP配置移到循环外，仅初始化一次，提升批量发送的效率。

必做前置设置 #

1. CDO库引用：打开VBA编辑器，点击「工具」→「引用」，勾选Microsoft CDO for Windows 2000 Library（若找不到，可改用后期绑定替换对象声明）。
2. Gmail权限配置：
   • 开启Gmail的「IMAP访问」（Gmail设置→转发和POP/IMAP→启用IMAP）
   • 若账号开启了两步验证，必须使用应用密码（Google账号→安全→应用密码生成）；未开启两步验证需开启「不太安全的应用访问」（不推荐）。
3. 工作表名称：代码中默认使用Sheet1，若你的数据在其他工作表，需修改为对应名称。

内容的提问来源于stack exchange，提问作者CKD