不同的数据透视表发送到不同的电子邮件 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”来执行代码。

相关内容

热门资讯

我来教大家辅助器技巧!中至汾阳... 我来教大家辅助器技巧!中至汾阳麻将多功能辅助器技巧,中至汾阳麻将果然真的有辅助器技巧1、该软件可以轻...
分享实测辅助器app!欢乐碰胡... 分享实测辅助器app!欢乐碰胡多功能辅助器app,欢乐碰胡好像真的有辅助器app一、欢乐碰胡可以开透...
玩家必看科普外挂方法!大唐麻将... 玩家必看科普外挂方法!大唐麻将全集多功能外挂方法,大唐麻将全集一直真的是有外挂方法1、首先打开大唐麻...
我来教教大家透视器技巧!情怀信... 我来教教大家透视器技巧!情怀信阳多功能透视器技巧,情怀信阳总是存在有透视器技巧1)情怀信阳免费钻石:...
专业讨论开挂app!天听之旅多... 专业讨论开挂app!天听之旅多功能开挂app,天听之旅竟然真的是有开挂app1、每一步都需要思考,不...
一起来讨论作弊器方法!哈哈长沙... 一起来讨论作弊器方法!哈哈长沙麻将多功能作弊器方法,哈哈长沙麻将本来是真的有作弊器方法哈哈长沙麻将辅...
一分钟揭秘作弊器软件!星火燎原... 一分钟揭秘作弊器软件!星火燎原多功能作弊器软件,星火燎原原来存在有作弊器软件1、星火燎原辅助器安装包...
最新技巧透视器插件!聚贤多功能... 最新技巧透视器插件!聚贤多功能透视器插件,聚贤本来有透视器插件运聚贤辅助工具,进入游戏界面。进入聚贤...
必备科技作弊器app!白金岛红... 必备科技作弊器app!白金岛红拐弯多功能作弊器app,白金岛红拐弯果然存在有作弊器app1、进入到白...
总算了解辅助插件!欢乐划水麻将... 总算了解辅助插件!欢乐划水麻将多功能辅助插件,欢乐划水麻将好像是真的有辅助插件1、用户打开应用后不用...