不同的数据透视表发送到不同的电子邮件 VBA
创始人
2025-01-08 19:00:24
0次

以下是一个示例VBA代码,用于将不同的数据透视表发送到不同的电子邮件地址。

Sub SendPivotTablesByEmail()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim rng As Range
    Dim wsEmail As Worksheet
    Dim rngEmail As Range
    Dim cell As Range
    Dim outlookApp As Object
    Dim outlookMail As Object
    
    ' 打开目标工作簿
    Set wb = Workbooks.Open("C:\路径\目标工作簿.xlsx")
    ' 设置目标工作表
    Set ws = wb.Worksheets("目标工作表")
    
    ' 遍历每个数据透视表
    For Each pt In ws.PivotTables
        ' 清除之前的筛选
        pt.ClearAllFilters
        
        ' 设置筛选条件(可根据需要修改)
        pt.PivotFields("字段1").CurrentPage = "条件1"
        pt.PivotFields("字段2").CurrentPage = "条件2"
        
        ' 将数据透视表复制到新工作簿
        pt.TableRange1.Copy
        Set rng = ThisWorkbook.Worksheets.Add().Range("A1")
        rng.PasteSpecial xlPasteValues
        
        ' 保存新工作簿并关闭
        rng.Parent.SaveAs "C:\路径\" & pt.Name & ".xlsx"
        rng.Parent.Close False
        
        ' 创建 Outlook 应用程序对象
        Set outlookApp = CreateObject("Outlook.Application")
        ' 创建新邮件
        Set outlookMail = outlookApp.CreateItem(0)
        
        ' 设置邮件主题和收件人地址(可根据需要修改)
        With outlookMail
            .Subject = "数据透视表: " & pt.Name
            .To = "收件人1@example.com"
            .CC = "抄送人@example.com"
            
            ' 正文内容(可根据需要修改)
            .Body = "请查阅附件中的数据透视表。"
            
            ' 添加附件
            .Attachments.Add "C:\路径\" & pt.Name & ".xlsx"
            
            ' 发送邮件
            .Send
        End With
        
        ' 删除附件文件
        Kill "C:\路径\" & pt.Name & ".xlsx"
    Next pt
    
    ' 关闭目标工作簿
    wb.Close False
    
    ' 清除对象引用
    Set outlookMail = Nothing
    Set outlookApp = Nothing
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub

请确保以下操作:

  1. 将代码中的文件路径修改为目标工作簿的实际路径。
  2. 根据需要修改筛选条件、邮件主题、收件人地址等部分。
  3. 确保已启用 Outlook 应用程序。
  4. 请注意,此代码将逐个发送数据透视表的副本。如果数据透视表较大或数量较多,可能会影响性能和邮件服务器容量。

您可以将此代码复制并粘贴到 Excel 的 VBA 编辑器中(按 ALT + F11 打开)的模块中。之后,您可以通过运行 VBA 宏“SendPivotTablesByEmail”来执行代码。

相关内容

热门资讯

推荐攻略!wepoker免费辅... 推荐攻略!wepoker免费辅助器,WPK软件下载平台(原生是真的有透视挂)AI 智能体黑科技再上新...
一分钟了解!!we-poker... 一款 AI 游戏攻略黑科技工具上线,查攻略效率直接开挂。它整合版本更新、装备搭配、BOSS 打法、牌...
查到实测辅助!微扑克辅助下载,... AI 黑科技赛道又上新,这款智能处理工具堪称效率开挂,专门面向短视频创作者打造。它打通脚本撰写、AI...
一分钟带你了解!wpk透视辅助... 一分钟带你了解!wpk透视辅助下载,德扑之星能不能开挂助手(原本是有辅助器)AI 是一款可以让一直输...
实测交流!智星德州插件2024... 实测交流!智星德州插件2024最新版,wepoker到底有没有透视挂软件(最初是真的有透视)主打本地...
大家学习交流!wepokerp... 本地部署 AI 黑科技工具迎来新版本,不用上传文件到云端就能完成wepokerplus到底是挂了吗解...
专业讨论!!wepoker脚本... 很多人使用云端 AI 时,都担心wepoker脚本下载、内部资料上传带来隐私风险。这款本地运行的 A...
玩家必备科技!!wepoker... 本地部署 AI 黑科技工具迎来新版本,不用上传文件到云端就能完成wepoker插件辅助解析、 AI ...
终于知道!wpk辅助插件,we... 终于知道!wpk辅助插件,wepoker怎么开挂助手(原来是真的有透视)AI 智能体黑科技再上新,自...
玩家必看科普!wpk辅助器是真... 您好:wpk辅助器是真的吗这款游戏可以开挂的,确实是有挂的,很多玩家在这款游戏中打牌都会发现很多用户...