从0学Excel VBA编程 · 番外篇5：合并结果自动导出/邮件发送——让报表自己跑完最后一公里

学习目标

1. 搞懂"导出新文件"和"邮件发送"两件事分别靠什么对象来实现
2. 掌握把汇总表存成独立 Excel（带日期戳）的标准写法
3. 通过 3 个实战案例，做出导出、合并汇总后导出、导出并自动发邮件的完整工具

知识点精讲

前面番外篇 3、4 已经能把一堆 Excel 合并、去重、汇总成"汇总"表。但报表做完，往往还要交出去：发给领导、存档备份、或丢给同事。

这两步各有"专属工具"：

• 导出新文件：用 Workbooks.Add 新建一个空白工作簿，把汇总内容 Copy 过去，再 SaveAs 存成独立 .xlsx。关键点：文件名带上当天日期（Format(Date,"yyyy-mm-dd")），每天一份不覆盖；SaveAs 加 FileFormat:=51 明确存成 xlsx，避免格式弹窗。
• 邮件发送：用 CreateObject("Outlook.Application") 调起本机 Outlook，建一封邮件（CreateItem(0)），填 To / Subject / Body，用 Attachments.Add 文件路径 把刚导出的文件当附件，Send 发出去。

安全提醒：自动发邮件先用 .Display 弹出来人工确认再发；确认无误、想全自动时，再把 .Display 改成 .Send。另外，邮件功能要求本机装了 Outlook 并已登录，公司没装 Outlook 的电脑跑不起来。

3 个实战案例

案例 1（简单）：把"汇总"表导出成一个带日期的新 Excel 文件

功能说明：把当前工作簿里的"汇总"表，复制成一个独立的新 .xlsx 文件，文件名自动带上当天日期，存到工作簿所在目录。每天跑一次，自动留档，不互相覆盖。

操作步骤：

1. 确保本工作簿有"汇总"表，且本工作簿已保存（有路径）。
2. 按 Alt + F11 打开 VBA 编辑器，插入「标准模块」。
3. 粘贴下面代码，运行"导出汇总表为新文件"。
4. 去工作簿所在目录，能看到 汇总导出_2026-xx-xx.xlsx。

Sub 导出汇总表为新文件()    Dim 新簿 As Workbook    Dim 源表 As Worksheet    Dim 保存路径 As String, 日期戳 As String    Set 源表 = ThisWorkbook.Sheets("汇总")    日期戳 = Format(Date, "yyyy-mm-dd")    保存路径 = ThisWorkbook.Path & "\汇总导出_" & 日期戳 & ".xlsx"    Set 新簿 = Workbooks.Add    源表.UsedRange.Copy 新簿.Sheets(1).Range("A1")    新簿.Sheets(1).Name = "汇总"    新簿.SaveAs 保存路径, 51   ' 51 = .xlsx 格式    新簿.Close False    MsgBox "已导出到：" & vbCrLf & 保存路径, vbInformationEnd Sub

要点：Workbooks.Add 新建空白簿；源表.UsedRange.Copy 新簿.Sheets(1).Range("A1") 把内容（含表头数据）整块搬过去；SaveAs 路径, 51 的 51 是 xlsx 格式代号，写上它就不会弹"格式不兼容"的确认框。

案例 2（中等）：合并 + 汇总 + 导出一条龙

功能说明：把番外篇 3 的"合并"、番外篇 4 的"字典汇总"和本篇的"导出"三件事串成一个按钮：先合并「待合并」文件夹、再按产品汇总销量、最后把"销量汇总"表导出成带日期的文件。一步到位，无需手工衔接。

操作步骤：

1. 把本工作簿保存到某文件夹，旁边建「待合并」文件夹并放入结构相同的 Excel（第 1 列=产品，第 3 列=销量）。
2. 粘贴下面代码，运行"合并汇总并导出"。
3. 看"汇总""销量汇总"两张表已生成，目录里也多了 销量汇总_日期.xlsx。

Sub 合并汇总并导出()    Dim fso As Object, 文件夹 As Object, 文件 As Object    Dim 源表 As Worksheet, 源簿 As Workbook, 总表 As Worksheet    Dim 字典 As Object, 末行 As Long, 源末行 As Long, 列数 As Long    Dim 是首份 As Boolean, i As Long    Dim 产品 As String, 销量 As Double    Dim 结果表 As Worksheet, 新簿 As Workbook    Dim 保存路径 As String, 日期戳 As String, 键 As Variant, r As Long    ' —— 第一步：FSO 合并（同番外篇3） ——    On Error Resume Next    Set 总表 = ThisWorkbook.Sheets("汇总")    Set 结果表 = ThisWorkbook.Sheets("销量汇总")    On Error GoTo 0    If 总表 Is Nothing Then        Set 总表 = ThisWorkbook.Sheets.Add        总表.Name = "汇总"    End If    If 结果表 Is Nothing Then        Set 结果表 = ThisWorkbook.Sheets.Add        结果表.Name = "销量汇总"    End If    总表.Cells.Clear    是首份 = True    Set fso = CreateObject("Scripting.FileSystemObject")    Set 文件夹 = fso.GetFolder(ThisWorkbook.Path & "\待合并")    For Each 文件 In 文件夹.Files        If LCase(fso.GetExtensionName(文件.Name)) = "xlsx" Then            Set 源簿 = Workbooks.Open(文件.Path)            Set 源表 = 源簿.Sheets(1)            源末行 = 源表.Cells(源表.Rows.Count, 1).End(xlUp).Row            If 源末行 > 1 Then                If 是首份 Then                    列数 = 源表.UsedRange.Columns.Count                    源表.Range("A1").Resize(源末行, 列数).Copy 总表.Range("A1")                    是首份 = False                Else                    源表.Range("A2").Resize(源末行 - 1, 列数).Copy _                        总表.Cells(总表.Rows.Count, 1).End(xlUp).Offset(1, 0)                End If            End If            源簿.Close False        End If    Next 文件    ' —— 第二步：字典按产品汇总销量（同番外篇4） ——    Set 字典 = CreateObject("Scripting.Dictionary")    末行 = 总表.Cells(总表.Rows.Count, 1).End(xlUp).Row    For i = 2 To 末行        产品 = 总表.Cells(i, 1).Value        If 产品 <> "" Then            销量 = Val(总表.Cells(i, 3).Value)            If 字典.Exists(产品) Then                字典(产品) = 字典(产品) + 销量            Else                字典.Add 产品, 销量            End If        End If    Next i    结果表.Cells.Clear    结果表.Range("A1").Value = "产品"    结果表.Range("B1").Value = "销量合计"    r = 2    For Each 键 In 字典.Keys        结果表.Cells(r, 1).Value = 键        结果表.Cells(r, 2).Value = 字典(键)        r = r + 1    Next 键    ' —— 第三步：导出"销量汇总"表 ——    日期戳 = Format(Date, "yyyy-mm-dd")    保存路径 = ThisWorkbook.Path & "\销量汇总_" & 日期戳 & ".xlsx"    Set 新簿 = Workbooks.Add    结果表.UsedRange.Copy 新簿.Sheets(1).Range("A1")    新簿.SaveAs 保存路径, 51    新簿.Close False    MsgBox "已合并、汇总并导出到：" & vbCrLf & 保存路径, vbInformationEnd Sub

要点：三段逻辑首尾相接——合并产出"汇总"表、字典汇总产出"销量汇总"表、最后把"销量汇总"表导出。换汇总维度（如按部门汇总工资），只改第二步的分组列号与求和列号即可，导出部分不用动。

案例 3（实用小案例）：导出后自动用 Outlook 把文件发给领导

功能说明：在案例 1 基础上加"自动发邮件"——先把"销量汇总"表导出成文件，再用本机 Outlook 建一封带附件的邮件发给指定收件人。先 .Display 弹出来让你确认，无误再点发送，避免误发。

操作步骤：

1. 本工作簿有"销量汇总"表（可由案例 2 生成），且本机已安装并登录 Outlook。
2. 粘贴下面代码，把 邮件.To 改成真实收件邮箱。
3. 运行"导出并邮件发送"，Outlook 会弹出邮件预览，确认后点击发送即可。

Sub 导出并邮件发送()    Dim 源表 As Worksheet, 新簿 As Workbook    Dim 保存路径 As String, 日期戳 As String    Dim outlook As Object, 邮件 As Object    日期戳 = Format(Date, "yyyy-mm-dd")    保存路径 = ThisWorkbook.Path & "\销量汇总_" & 日期戳 & ".xlsx"    Set 源表 = ThisWorkbook.Sheets("销量汇总")    ' 先导出    Set 新簿 = Workbooks.Add    源表.UsedRange.Copy 新簿.Sheets(1).Range("A1")    新簿.SaveAs 保存路径, 51    新簿.Close False    ' 再发邮件（需本机已安装并登录 Outlook）    Set outlook = CreateObject("Outlook.Application")    Set 邮件 = outlook.CreateItem(0)   ' 0 = 邮件项    邮件.To = "boss@company.com"       ' 改成实际收件邮箱    邮件.Subject = "销售汇总 " & 日期戳    邮件.Body = "领导好，附件是今日销售汇总，请查收。" & vbCrLf & "（本邮件由 Excel 宏自动生成）"    邮件.Attachments.Add 保存路径    邮件.Display   ' 先弹出预览确认；确认无误可改 邮件.Send 直接发送    MsgBox "已生成邮件，请确认后点击发送。", vbInformationEnd Sub

要点：CreateObject("Outlook.Application") 调起 Outlook；CreateItem(0) 新建一封邮件；Attachments.Add 保存路径 把刚导出的文件挂为附件；邮件.Display 弹出来人工确认，这是防止误发的安全阀——想全自动直接发，把它换成 邮件.Send 即可（前提 Outlook 已登录且允许程序发信）。公司没装 Outlook 时，此段会报错，可改用网页邮箱手动发送，或接入邮件 API。

本篇小结

• 导出新文件：Workbooks.Add 建空白簿 → Copy 内容过去 → SaveAs 路径, 51 存 xlsx；文件名带 Format(Date,...) 日期戳，每天不覆盖。
• 邮件发送：CreateObject("Outlook.Application") + CreateItem(0) 建邮件，填 To/Subject/Body，Attachments.Add 文件路径 挂附件；.Display 预览、.Send 直发。
• 三件事可串一条龙：合并（番外篇3）→ 字典汇总（番外篇4）→ 导出/发送（本篇），一个按钮跑完"收集→统计→交付"全流程。
• 两条铁律：SaveAs 写 FileFormat:=51 避免格式弹窗；发邮件先用 .Display 确认，再考虑 .Send。
• 前提限制：自动发信依赖本机 Outlook 已安装登录；无 Outlook 环境需改用网页邮箱或邮件 API。

下一篇内容预告

本篇是《从0学Excel VBA编程》番外篇5（导出/邮件发送）。至此"多文件收集 → 清洗去重 → 统计汇总 → 导出发送"的完整自动化链路已经打通。下一篇可选：

• 番外篇6：在 VBA 里用 SQL——直接对表格写 SELECT 做筛选汇总，比循环更清爽；
• 或 番外篇6：定时自动运行——让报表每天上班前自动跑完并发到邮箱（配合 Windows 任务计划）。 需要哪个，告诉我就行。