Question

目前，我每天都需要报告，要求我向人们发送电子邮件。我已经自动化了报告，现在也希望自动化电子邮件。但是，我似乎无法使嵌入式图表与HTML代码中的复制范围一起使用。

电子邮件格式如下：

范围1
图表1-3
范围2
范围3
图4-9

我已成功使用Ron de Bruin的rangeToHTML函数获取使用复制范围的电子邮件，但我还没有获得任何电子邮件与HTMLBody中的嵌入式图表一起使用。

他们只是在消息中根本没有显示，我按照说明操作但它不起作用。这就是我所拥有的：

Public Sub SendEmail(ToList As String, CCList As String, Subject As String, ReportType As String)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim HTMLString As String

    If ReportType = "Daily" Then
        HTMLString = BuildDaily
    End If

    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    With OutlookMail
        .To = ToList
        .CC = CCList
        .BCC = ""
        .Subject = Subject
        .BodyFormat = olFormatHTML
        .HTMLBody = HTMLString
        .Attachments.Add "H:\SameDayChart.png", olByValue, 0 'Test to see if attachment would work
        .Display
    End With
    Kill FileName
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing

'Build the HTML String for the daily report and return it
Private Function BuildDaily() As String
    Dim Charts(6) As String
    Dim HTMLString As String
    Dim lastRow As Long
    Dim Cases As Worksheet
    Set Cases = Sheets("Cases")
    lastRow = Cases.UsedRange.Rows.Count

    Charts(1) = "SameDayChart"
    Charts(2) = "OpenChart"
    Charts(3) = "CurrentChart"

    HTMLString = HTMLString & "<br>" & RangetoHTML(Sheets("Total").Range("A1:H25")) 'Add the total Range
    HTMLString = HTMLString & "<br>" & AddHTMLCharts(Sheets("Total"), Charts(), 1) 'Add the first 3 charts
    Charts(1) = "CPieChart"
    Charts(2) = "GPieChart"
    Charts(3) = "FPieChart"
    Charts(4) = "CChart"
    Charts(5) = "GChart"
    Charts(6) = "FChart"
    HTMLString = HTMLString & "<br>" & RangetoHTML(Cases.Range("A3:D" & lastRow)) 'Add the Cases
    HTMLString = HTMLString & "<br>" & RangetoHTML(Sheets("Team").Range("A24:D42")) 'Add the team
    HTMLString = HTMLString & "<br>" & AddHTMLCharts(Sheets("Total"), Charts(), 3) 'Add the last 6 charts

    BuildDaily = HTMLString
End Function

Private Function AddHTMLCharts(sheetName As Worksheet, Charts() As String, newLineAfter As Long) As String
        'Export the images for the daily report to files
        Dim HTMLString As String
        Dim N As Long

        For N = LBound(Charts) To UBound(Charts)
            If Charts(N) <> "" Then
                sheetName.ChartObjects(Charts(N)).Chart.Export "H:\" & Charts(N) & ".png"
                If newLineAfter = N Then
                    HTMLString = HTMLString & "<img src='cid:" & Charts(N) & ".png'><br>"
                Else
                    HTMLString = HTMLString & "<img src='cid:" & Charts(N) & ".png' style='margin-right:10px;'>"
                End If
            Else
                Exit For
            End If
        Next N

        AddHTMLCharts = HTMLString
End Function

Private Function RangetoHTML(rng As Range)
' By Ron de Bruin.
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         FileName:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

所以基本上所有3个范围都显示正常，但是没有任何图表显示，无论是否添加了附件。

如何让图表显示出来？ HTML就在那里，并且根据我在其他帖子上看到的内容是正确的。

非常感谢任何帮助。

更新由于我在Outlook中使用宏（他们被禁用）的限制，我不得不做一些变通方法，以使其正常工作，但我做到了。基本上我将它作为图片复制到图表中，调整图表大小然后导出图表，将其添加为隐藏附件，然后使用简单的HTML将图像添加到内嵌邮件中。其中一个范围我不得不分成3张单独的图片，因为它没有正确缩放，看起来非常模糊，但现在已经解决了。

使用带有复制范围和嵌入图表的Outlook发送电子邮件

0 个答案: