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

相关内容

热门资讯

透视模拟器!wpk辅助器下载,... 透视模拟器!wpk辅助器下载,途游四川小程序脚本辅助,攻略教程(有挂技巧);科技安装教程;13670...
透视软件!wepoker辅助透... 1、透视软件!wepoker辅助透视软件,随意玩透视辅助,微扑克教程(有挂辅助)。2、随意玩透视辅助...
透视ai代打!红龙poker作... 透视ai代打!红龙poker作弊指令,老k麻将有挂吗,攻略方法(有挂技巧)1、点击下载安装,微扑克w...
辅助透视!德普之星透视辅助软件... 1、辅助透视!德普之星透视辅助软件下载,中至赣牌圈祈福有用吗,玩家教程(有挂教程)。2、中至赣牌圈祈...
透视app!wpk辅助购买,欢... 透视app!wpk辅助购买,欢乐对决辅助,黑科技教程(有挂软件);小薇(透视辅助)致您一封信;亲爱欢...
透视好牌!智星菠萝辅助怎么买,... 这是一款非常优秀的丽水都来大菠萝脚本辅助 ia辅助检测软件,能够让你了解到丽水都来大菠萝脚本辅助中牌...
透视实锤!hhpoker辅助器... 透视实锤!hhpoker辅助器,闲来山水广西辅助,2025新版技巧(有挂软件);实战中需综合运用上述...
透视好牌!智星菠萝辅助,心悦填... 透视好牌!智星菠萝辅助,心悦填大坑辅助器,可靠技巧(有挂神器);最新版2024是一款经典耐玩的益智游...
透视最新!智星德州菠萝安装,越... 透视最新!智星德州菠萝安装,越乡游义乌辅助,新2025教程(有挂技巧);科技安装教程;1367043...
透视中牌率!wpk辅助软件,雀... 透视中牌率!wpk辅助软件,雀友会广东潮汕辅助透视,爆料教程(有挂方法);小薇(透视辅助)致您一封信...