Excel VBA自动导出图表表格至Outlook邮件问题求助

以下是针对需求的完整VBA实现，可按指定顺序将Excel中的文本、图表、表格插入到Outlook邮件中，解决现有代码缺失图表和表格的问题：

核心实现逻辑 #

• 文本内容：直接复制Excel单元格区域，粘贴到邮件正文
• 图表：将指定图表导出为临时PNG图片，插入邮件后自动清理临时文件
• 表格：复制Excel表格区域，以HTML格式粘贴到邮件，保留原表格样式

完整代码 #

Sub GenerateHedgeProposalEmail()
    Dim olApp As Object
    Dim olMail As Object
    Dim ws As Worksheet
    Dim tempPath As String
    Dim chartObj As ChartObject
    
    ' 绑定目标工作表（替换为实际工作表名称）
    Set ws = ThisWorkbook.Worksheets("对冲提案工作表")
    ' 生成唯一临时图片路径
    tempPath = Environ("TEMP") & "\temp_chart_" & Format(Now(), "YYYYMMDDHHMMSS") & ".png"
    
    ' 初始化Outlook应用及邮件对象
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    
    With olMail
        .Subject = "每周对冲提案 " & Format(Now(), "YYYY年MM月DD日")
        .To = "指定收件人邮箱" ' 替换为实际收件人邮箱
        .HTMLBody = "<html><body>" ' 初始化HTML邮件结构
        
        ' 1. 插入A14:A17文本内容
        ws.Range("A14:A17").Copy
        .GetInspector.WordEditor.Range.Paste
        
        ' 2. 插入Chart 15图表
        Set chartObj = ws.ChartObjects("Chart 15")
        chartObj.Chart.Export tempPath, "PNG"
        .Attachments.Add tempPath, 1 ' 以附件形式嵌入图片
        .HTMLBody = .HTMLBody & "<br><img src='cid:" & Mid(tempPath, InStrRev(tempPath, "\") + 1) & "'><br>"
        
        ' 3. 插入A36:I46表格
        ws.Range("A36:I46").Copy
        .GetInspector.WordEditor.Range.PasteSpecial DataType:=10 ' 以HTML格式粘贴
        
        ' 4. 插入A48:A50文本内容
        ws.Range("A48:A50").Copy
        .GetInspector.WordEditor.Range.Paste
        
        ' 5. 插入A52:E57表格
        ws.Range("A52:E57").Copy
        .GetInspector.WordEditor.Range.PasteSpecial DataType:=10
        
        ' 6. 插入A62:A65文本内容
        ws.Range("A62:A65").Copy
        .GetInspector.WordEditor.Range.Paste
        
        ' 7. 插入Chart 2图表
        Set chartObj = ws.ChartObjects("Chart 2")
        chartObj.Chart.Export tempPath, "PNG"
        .Attachments.Add tempPath, 1
        .HTMLBody = .HTMLBody & "<br><img src='cid:" & Mid(tempPath, InStrRev(tempPath, "\") + 1) & "'><br>"
        
        ' 8. 插入A89:K99表格
        ws.Range("A89:K99").Copy
        .GetInspector.WordEditor.Range.PasteSpecial DataType:=10
        
        .HTMLBody = .HTMLBody & "</body></html>"
        .Display ' 显示邮件供检查，需直接发送可改为 .Send
    End With
    
    ' 清理临时图片文件
    Kill tempPath
    
    ' 释放对象资源
    Set olMail = Nothing
    Set olApp = Nothing
    Set chartObj = Nothing
    Set ws = Nothing
End Sub

关键配置说明 #

1. 工作表名称：将代码中的"对冲提案工作表"替换为存放数据的实际工作表名称
2. 收件人设置：修改.To = "指定收件人邮箱"为实际收件人邮箱地址
3. 图表名称匹配：确保代码中的"Chart 15"和"Chart 2"与Excel中图表的名称完全一致（可在Excel【图表工具-格式】选项卡查看图表名称）
4. 邮件操作：默认使用.Display显示邮件，确认内容无误后可改为.Send直接发送

内容的提问来源于stack exchange，提问作者Knowhledge