当前位置：首页>Excel>VBA发送邮件:自动将Excel表格邮件推送

VBA发送邮件:自动将Excel表格邮件推送

2026-03-23 07:44:12

点击上方蓝字关注VBA应用大全

畅享Excel中的VBA应用技术

原创作者：李锐

微信公众号：VBA应用大全（VbaApp）

微信服务号：跟李锐学Excel（LiRuiExcel）

VBA发送邮件：自动将Excel表格邮件推送

一句话核心价值点：
让零基础职场人用不到30行VBA，把重复发邮件的苦差变成一键完成，2026年效率翻倍不加班。

Sub 批量发销售表()
    Dim olApp As Object, olMail As Object
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("销售表")
    Set olApp = CreateObject("Outlook.Application")

    Dim 收件人 As Variant, i As Integer
    收件人 = Array("a@co.com", "b@co.com", "c@co.com")

    For i = 0 To UBound(收件人)
        Set olMail = olApp.CreateItem(0)
        With olMail
            .To = 收件人(i)
            .Subject = "2026年1月销售表"
            .Body = "您好，附件为本月销售数据，请查收。"
            .Attachments.Add ws.Copy.Range("A1:G20").Value '实际需保存为文件再附加
            .Send
        End With
    Next i
    MsgBox "已分批发出！"
End Sub

原理很简单：用Outlook对象当邮差，把表格指定区域先存成临时文件，再挂到邮件上。循环遍历名单，就像流水线作业，人只需点一次按钮。函数和透视表只能帮你算好数据，没法替你跑腿送信，VBA却能打通计算和传递，让数据自己长腿找人。

附件命名乱糟糟？自动规整

有时表格按日期或部门命名附件，手动改容易出错，收件人收到“新建xlsx”“sheet1副本”会懵圈。

Sub 自动命名发邮件()
    Dim olApp As Object, olMail As Object
    Dim ws As Worksheet, 文件名 As String
    Set ws = ThisWorkbook.Sheets("业绩")
    Set olApp = CreateObject("Outlook.Application")

    文件名 = "2026_01_业绩_" & ws.Range("B2").Value & ".xlsx"
    ws.Copy
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & 文件名
    ActiveWorkbook.Close False

    Set olMail = olApp.CreateItem(0)
    With olMail
        .To = ws.Range("C2").Value
        .Subject = "2026年1月业绩表"
        .Body = "附件已按您部门命名。"
        .Attachments.Add ThisWorkbook.Path & "\" & 文件名
        .Display '可改为.Send直接发
    End With
    MsgBox "命名妥了，发出去吧！"
End Sub

这里VBA先读单元格里的部门名，拼成“2026_01_业绩_市场部.xlsx”，再把表另存。函数和透视表能生成名字规则，却不会替你动手改文件并塞进邮件，VBA把规则和动作串成一条线，省掉肉眼核对的时间。

收件人名单常变动？智能抓取

名单写在另一张表里，每周新人来旧人走，手动复制粘贴收件人容易漏人或多贴。

Sub 智能抓名单发邮件()
    Dim olApp As Object, olMail As Object
    Dim wsData As Worksheet, wsList As Worksheet
    Dim rng As Range, cell As Range
    Set wsData = ThisWorkbook.Sheets("数据")
    Set wsList = ThisWorkbook.Sheets("名单")
    Set olApp = CreateObject("Outlook.Application")

    Set rng = wsList.Range("A2:A" & wsList.Cells(wsList.Rows.Count, "A").End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            Set olMail = olApp.CreateItem(0)
            With olMail
                .To = cell.Value
                .Subject = "2026年周报推送"
                .Body = "本周数据见附件。"
                .Attachments.Add wsData.Copy.Range("A1:E30").Value '示意路径
                .Display
            End With
        End If
    Next cell
    MsgBox "按名单发完啦！"
End Sub

VBA直接从名单表抓非空邮箱，像自动数人头发糖，不怕漏发也不怕多发。函数公式能筛选名单，但不能主动触发邮件流程，VBA让数据表和邮件形成活的连接，名单一变，动作跟着变。

邮件正文太呆板？动态植入

每次正文都写“您好，见附件”，领导想看到关键数字却得打开文件才知，沟通效率低。

Sub 正文嵌关键值()
    Dim olApp As Object, olMail As Object
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("汇总")
    Set olApp = CreateObject("Outlook.Application")

    Dim 销售额 As String, 达成率 As String
    销售额 = ws.Range("D5").Value
    达成率 = ws.Range("E5").Value

    Set olMail = olApp.CreateItem(0)
    With olMail
        .To = ws.Range("F2").Value
        .Subject = "2026年1月关键指标"
        .Body = "您好，本月销售额：" & 销售额 & "元，达成率：" & 达成率 & "%。详见附件。"
        .Attachments.Add ws.Copy.Range("A1:F10").Value '示意
        .Display
    End With
    MsgBox "数字已跳进正文！"
End Sub

VBA把单元格的数字直接抓进句子里，收件人瞄一眼就抓住重点。函数和透视表擅长分析，但没法把分析结果写进邮件语气中，VBA让数据和表达合体，信息传递一步到位。

定时推送怕忘事？自动守时

月末汇报若遇上出差或会议，忘记发邮件可能误事，人工盯时间不靠谱。

Sub 定时发邮件()
    Dim olApp As Object, olMail As Object
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("提醒")
    Set olApp = CreateObject("Outlook.Application")

    Application.OnTime TimeValue("17:00"), "发邮件过程"
    MsgBox "已设好17点自动发邮件"
End Sub

Sub 发邮件过程()
    Dim olMail As Object
    Set olMail = CreateObject("Outlook.Application").CreateItem(0)
    With olMail
        .To = ws.Range("A2").Value
        .Subject = "2026年1月定时推送"
        .Body = "系统时间到，自动奉上数据。"
        .Attachments.Add ws.Copy.Range("A1:D15").Value '示意
        .Send
    End With
End Sub