Question

在尝试将多个图表嵌入到电子邮件中时遇到了一些问题，它在1个图表中运行良好。

我认为问题在于为每个循环添加附件。我应该在图片标签中使用完整文件名还是只使用文件名？

Sub SaveSend_Embedded_Chart()

Dim OutApp As Object
Dim OutMail As Object
Dim Fname, Tname, TempFilePath As String
Dim co As ChartObject

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'File path/name of the gif file
Fname = ""
TempFilePath = Environ$("temp") & "\"

'Save Chart named "Chart 1" as gif file
'If you hold down the CTRL key when you select the chart
'in 2000-2013 you see the name in the Name box(formula bar)


On Error Resume Next
With OutMail
    .To = getEmailAdresses()
    .CC = ""
    .BCC = ""
    .Subject = "The worksheet has been updated"
    '.Body = "Hi there"
    .HTMLBody = "<span LANG=EN>" _
            & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
            & "Hello,<br ><br >The updated <a href=""" & ThisWorkbook.FullName & """>Worksheet</a> is available " _
            & "<br>Find below an overview :<BR>" _
            & ThisWorkbook.outString

    .HTMLBody = .HTMLBody & "<br><B>GRAPH REPPORT:</B><br>"

       For Each co In ThisWorkbook.Sheets("STATUS").ChartObjects

            'co = ThisWorkbook.Sheets("STATUS").ChartObjects
            Fname = co.Name & ".jpg" 'Filename
            Tname = TempFilePath & Fname 'Full Filename
            co.Chart.Export Filename:=Tname, FilterName:="JPEG"
            .Attachments.Add Tname, olByValue, 1, co.Name
            .HTMLBody = .HTMLBody & "<img src=cid:'" & Tname & "' width='814' height='400'><br>"

            'Delete the  file
            Kill Tname

        Next co

    .HTMLBody = .HTMLBody & "<br>Best Regards,<br>" & Environ("username") & "</font></span>"

    '.Send   'or use
    .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

将多个图表嵌入电子邮件中

0 个答案: