通过 Excel VBA 在电子邮件中添加图表作为附件或正文的一部分

Question

我想在用户单击按钮时在电子邮件中附加图表。

代码未添加图表。

命名正确，我没有收到任何错误（除了我为帮助测试而实施的错误）。

If ChartNameLine = "" Then
    GoTo ErrorMsgs
Else
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xChartName As String
    Dim xPath As String
    Dim xChart As ChartObject
    Dim xChartPath As String
    
    On Error Resume Next
    xChartName = Application.InputBox("Please Enter the Chart name: ", "KuTools for Excel", , , , , , 2)
    'xChartName = ChartNameLine
    Set xChart = Worksheets(.HTMLBody).ChartObjects(xChartName)
    xChart.Chart.ChartArea.Copy
    
    errorCode = 101
    'If xChart Is Nothing Then GoTo ErrorMsgs
    
    xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xChartPath = ThisWorkbook.path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src= " / "cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """ width = 800 height = 500> <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = ToLine
        .Subject = SubjectLine
        .Attachments.Add xChartPath
        .HTMLBody = xPath
        .Display
    End With
    Kill xChartPath
    'Set xOutMail = Nothing
    'Set xOutApp = Nothing
End If

使用“Extend Office”中的代码

Answer 1

首先，HTMLBody 属性 returns or 设置一个字符串表示指定项的HTML 正文。如果您需要添加在 Excel 中生成的图像，您很可能需要将其插入邮件中的某个位置，而不是通过将其设置为段落 HTML 标记来替换整个邮件。因此，在 HTML 文档中找到一个合适的位置，然后将生成的 HTML 片段插入到那里，而不是替换整个邮件正文。

其次，确保生成正确的图像并将其保存到磁盘。 Excel 端的图像生成过程没有问题。

第三，您可能需要在附加图片上设置 PR_ATTACH_CONTENT_ID 属性以便 Outlook 可以轻松识别嵌入的图片。

Answer 2

在新工作簿中创建一个图表，其中 sheet 名为“test”。该图表应命名为“图表 1”。

新工作簿中没有其他代码。

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Sub AddWorksheetTestChartToMail()
    
    Dim xOutApp As Object
    Dim xOutMail As Object
    
    Dim xChartName As String
    Dim xPath As String
    Dim xChart As ChartObject
    Dim xChartPath As String
            
    xChartName = "Chart 1"
    
    ' "test", not .HTMLBody
    Set xChart = Worksheets("test").ChartObjects(xChartName)
    
    xChart.Chart.ChartArea.Copy
    
    ' Set was missing
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    
    xChartPath = ThisWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    Debug.Print xChartPath
    
    ' suggested fix in comment on the question post - src=""cid:"
    xPath = "<p align='Left'><img src=""cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    
    xChart.Chart.Export xChartPath
    
    With xOutMail
        .To = "ToLine"
        .Subject = "SubjectLine"
        .Attachments.Add xChartPath
        .HTMLBody = xPath
        .Display
    End With
    
    Kill xChartPath

End Sub

通过 Excel VBA 在电子邮件中添加图表作为附件或正文的一部分

Adding a chart as an attachment or part of the body in an email via Excel VBA

excel

outlook

vba