从0学Excel VBA编程 · 番外篇18：AI 生成报告 / 自动导出邮件——把数据变成报告，自己发走

学习目标

1. 明白「AI 生成报告」就是：把表格数据交给 AI 写一段总结，再写回 Excel
2. 会用 VBA 把 AI 生成的报告导出成一个独立 Excel 文件
3. 能做成「生成报告 → 导出 → 自动发邮件」一条龙，下班前让它自己跑完

知识点精讲

前面番外篇讲了三块本事：

• 番外篇16：用 VBA 调用 AI 大模型对话（发请求、收回答）
• 番外篇17：把表格数据批量交给 AI 分类、摘要
• 番外篇5：把工作表导出成新文件、用 Outlook 自动发邮件

本篇就是把这三块焊成一条流水线：数据 → AI 写报告 → 导出 xlsx → Outlook 发送。

整件事拆成 5 个公共函数（放同一个模块顶部，三案例共用）：

⚠️ 用前必做两件事：① 在 调用AI 里填你自己的 API Key；② VBE「工具 → 引用」勾选 Microsoft Scripting Runtime（装 VBA-JSON 那一步，番外篇13 讲过）。

【示意图】

3 个实战案例

下面 5 个公共函数要全部复制到模块顶部，三个案例才都能直接运行。

公共函数区（先复制这一整段）

'======== 公共函数区（本篇需全部复制到模块顶部）========' 1) 转义 JSON 特殊字符，避免引号、换行把 JSON 弄坏Function 转义JSON(s As String) As String    转义JSON = s    转义JSON = Replace(转义JSON, "\", "\\")    转义JSON = Replace(转义JSON, """", "\""")    转义JSON = Replace(转义JSON, vbCr, "\n")    转义JSON = Replace(转义JSON, vbLf, "\n")    转义JSON = Replace(转义JSON, vbTab, "\t")End Function' 2) 用 ADO 流把 HTTP 返回的字节解码成中文（UTF-8）Function 读HTTP文本(ByVal b() As Byte) As String    Dim st As Object    Set st = CreateObject("ADODB.Stream")    st.Type = 1   ' 二进制    st.Open    st.Write b    st.Position = 0    st.Type = 2   ' 文本    st.Charset = "UTF-8"    读HTTP文本 = st.ReadText    st.CloseEnd Function' 3) 调用 AI（OpenAI 兼容格式，以 DeepSeek 举例）Function 调用AI(问题 As String, _        Optional 系统角色 As String = "你是一个 helpful 的中文助手，回答简洁有条理。") As String    Dim http As Object, url As String, apiKey As String    Dim body As String, resp As String    Dim js As Object, arr As Object, msg As Object    apiKey = "在此填你的APIKey"          ' ← 改成你自己的 Key    url = "https://api.deepseek.com/v1/chat/completions"    Set http = CreateObject("MSXML2.XMLHTTP")    body = "{""model"":""deepseek-chat"",""messages"":[" & _           "{""role"":""system"",""content"":""" & 转义JSON(系统角色) & """}," & _           "{""role"":""user"",""content"":""" & 转义JSON(问题) & """}]}"    http.Open "POST", url, False    http.setRequestHeader "Content-Type", "application/json"    http.setRequestHeader "Authorization", "Bearer " & apiKey    http.Send body    resp = 读HTTP文本(http.responseBody)    Set js = JsonConverter.ParseJson(resp)    Set arr = js("choices")    Set msg = arr(1)("message")    调用AI = msg("content")End Function' 4) 导出指定工作表为新 Excel 文件（带日期不覆盖）Sub 导出工作表为新文件(源表 As Worksheet, 保存路径 As String)    Dim wb As Workbook    Set wb = Workbooks.Add    源表.Cells.Copy wb.Sheets(1).Cells(1, 1)    wb.SaveAs 保存路径, 51    wb.Close FalseEnd Sub' 5) 用 Outlook 发一封带附件的邮件Sub 发送邮件带附件(收件人 As String, 主题 As String, 正文 As String, 附件路径 As String)    Dim ol As Object, mail As Object    Set ol = CreateObject("Outlook.Application")    Set mail = ol.CreateItem(0)    With mail        .To = 收件人        .Subject = 主题        .Body = 正文        .Attachments.Add 附件路径        .Display          ' 先弹出来预览；要直接发送改成 .Send    End WithEnd Sub

案例 1：让 AI 把一段话写成总结（最简单，先跑通）

功能说明：把一段文字交给 AI，让它整理成一句简洁总结，写进 A1。验证「调用 AI → 写回」这条链路通不通。

Sub 案例1_让AI写总结()    Dim 文本 As String    文本 = "我们店本月卖了120台空调、80台冰箱、200台洗衣机，空调利润最高。"    Range("A1").Value = 调用AI("请把这段话整理成一句简洁的月度销售总结：" & 文本)    MsgBox "已生成总结，写进 A1！", vbInformationEnd Sub

操作步骤：

1. 新建模块，先粘贴上面的「公共函数区」。
2. 再粘贴本案例过程。
3. 在 调用AI 里把 在此填你的APIKey 换成你自己的 Key。
4. 光标放本过程内，按 F5 运行。
5. 看 A1 单元格，已出现 AI 写的总结。

案例 2：AI 生成周报，并导出成文件（中等）

功能说明：把 A 列每行销售记录拼成大段文字，交给 AI 生成结构清晰周报，写进新工作表后导出为带日期的 xlsx。

Sub 案例2_生成报告并导出()    Dim 数据 As String, i As Long, 报告 As String    Dim 路径 As String, 新表 As Worksheet    ' 1) 把 A 列数据拼成一大段    数据 = "": i = 1    Do While Cells(i, 1).Value <> ""        数据 = 数据 & Cells(i, 1).Value & vbCrLf        i = i + 1    Loop    If 数据 = "" Then MsgBox "A 列没有数据", vbExclamation: Exit Sub    ' 2) 让 AI 生成周报    报告 = 调用AI("根据以下销售记录，生成一份结构清晰的周报（含数据亮点和下一步建议）：" _                  & vbCrLf & 数据)    ' 3) 写进新工作表    Set 新表 = Sheets.Add(After:=Sheets(Sheets.Count))    新表.Name = "AI报告"    新表.Range("A1").Value = 报告    新表.Columns(1).ColumnWidth = 80    ' 4) 导出带日期的新文件    路径 = ThisWorkbook.Path & "\销售周报_" & Format(Date, "yyyymmdd") & ".xlsx"    导出工作表为新文件 新表, 路径    MsgBox "报告已生成并导出：" & 路径, vbInformationEnd Sub

操作步骤：

1. 在 A 列第 1 行起，每行填一条销售记录（如「8-1 空调 30 台」）。
2. 公共函数区 + 本案例一起放进模块。
3. 填好 API Key，F5 运行。
4. 同文件夹下出现 销售周报_20260831.xlsx，打开即是 AI 写的周报。

案例 3：生成报告 → 导出 → 自动发邮件（实用一条龙）

功能说明：把案例 2 再往前推一步——报告生成导出后，自动用 Outlook 把文件作为附件发给领导。集成 On Error 兜底，出错弹窗不崩。

Sub 案例3_生成报告导出并发邮件()    On Error GoTo 出错    Dim 数据 As String, i As Long, 报告 As String    Dim 路径 As String, 新表 As Worksheet, 收件人 As String    ' 1) 收集 A 列数据    数据 = "": i = 1    Do While Cells(i, 1).Value <> ""        数据 = 数据 & Cells(i, 1).Value & vbCrLf: i = i + 1    Loop    If 数据 = "" Then MsgBox "A 列没有数据", vbExclamation: Exit Sub    ' 2) AI 生成报告    报告 = 调用AI("根据以下数据，生成一份周报（含数据亮点和下一步建议）：" & vbCrLf & 数据)    ' 3) 写表 + 导出    Set 新表 = Sheets.Add(After:=Sheets(Sheets.Count))    新表.Name = "AI报告"    新表.Range("A1").Value = 报告    新表.Columns(1).ColumnWidth = 80    路径 = ThisWorkbook.Path & "\销售周报_" & Format(Date, "yyyymmdd") & ".xlsx"    导出工作表为新文件 新表, 路径    ' 4) 发邮件    收件人 = "boss@company.com"   ' ← 改成领导邮箱    发送邮件带附件 收件人, "销售周报 " & Format(Date, "yyyy-mm-dd"), _        "领导好，附件是今日 AI 生成的销售周报，请查收。", 路径    MsgBox "报告已生成、导出并发出！", vbInformation    Exit Sub出错:    MsgBox "出错：" & Err.Description, vbCriticalEnd Sub

操作步骤：

1. A 列填数据，把 boss@company.com 改成真实收件人。
2. 公共函数区 + 本案例放进模块，填好 API Key。
3. 本机需已安装并登录 Outlook，否则发信会报错。
4. F5 运行，会自动弹出邮件预览（.Display）——检查无误后手动点发送；想全自动就把它改成 .Send。
5. 接上番外篇6 的 Application.OnTime，就能每天下班前自动跑完这条线。

本篇小结

• 一条龙本质：数据 → 拼提示词 → 调用AI → 写回 → 导出工作表为新文件 → 发送邮件带附件，五步串起来。
• 关键点：API Key 自己填；VBA-JSON + Microsoft Scripting Runtime 引用要装好；邮件先用 .Display 预览再 .Send。
• 能落地：配合番外篇6 的定时任务，这就是个「每天自动出报告并发邮件」的小机器人。

下一篇预告

番外篇已写到第 18 篇，AI 办公链基本闭合。下一步可选：

• 收尾篇：把番外篇 1~18 + 前期收尾篇整理成《VBA 自动化工具箱》总目录
• 新主题：正则表达式 RegExp 清洗文本、VBA 调用 Python 跑重活

想收尾做总目录，还是开新主题，告诉我即可。