通过邮件发送Excel图表（Outlook）

Question

I found a code that turns a range of cell in Excel to a photo. That photo is delivered by mail. The problem is that when i'm using .Display everything is OK but when i'm using .Send the message sent empty.

Here is the code:

Sub Send_Pt_mail()

Dim OutApp As Object
Dim OutMail As Object
Dim Fname As String
Dim ch As ChartObject


'Prepare screen data file

Set ch = Worksheets("Chart").ChartObjects.Add(Range("Photo2Mail").Left, Range("Photo2Mail").Top, Range("Photo2Mail").Width, Range("Photo2Mail").Height)

'calculating the number of Recipients
iRow = Worksheets("Recipients").Cells(Rows.Count, 1).End(xlUp).Row
Recipients = ""
For i = 2 To iRow

'for each record in Recipients sheet an eMail will be send
If ThisWorkbook.Worksheets("Recipients").Cells(i, 2).Value = ThisWorkbook.Worksheets("Recipients").Cells(2, 7).Value Then
Recipients = Recipients & ThisWorkbook.Worksheets("Recipients").Cells(i, 1) & ";"
End If
Next i


'Prepare mail range as an image


Application.ScreenUpdating = True


    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    Fname = Environ$("temp") & "Mail_snap" & ".gif"

    'select the relevant table (update or new data) and export through Chart to file

    'then select the charts in dashboard and export through Chart 18 to file

    ch.Chart.ChartWizard Source:=Worksheets("DB").Range("Photo2Mail"), gallery:=xlLine, Title:="New Chart"

 '   ch.Chart.ChartArea.ClearContents

 '   ch.Width = 1700

 '   ch.Height = 900

    Chart_Name = ch.Name

    Worksheets("DB").Activate
    Range("Photo2Mail").Select

    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    Worksheets("Chart").ChartObjects(Chart_Name).Activate

    ActiveChart.Paste

    ActiveWorkbook.Worksheets("Chart").ChartObjects(Chart_Name).Chart.Export Filename:=Fname, FilterName:="gif"


        S = "<img src=" & Fname & "><br>"


    'On Error Resume Next

    With OutMail

        .To = Recipients

        .CC = ""

        .BCC = ""

        .Subject = ThisWorkbook.Worksheets("Recipients").Cells(3, 4) & "  " & Format(Now(), "dd/mm/yyyy")

        .Save

        .HTMLBody = S


             ' send

             .display


    End With

    On Error GoTo 0

    Kill Fname

    ch.Delete

StopMacro:


    Set OutMail = Nothing

    Set OutApp = Nothing

Application.ScreenUpdating = False
If (ActiveWindow.Zoom <> 100) Then

    ActiveWindow.Zoom = 100

End If

End Sub

Answer 1

If the mail body is not updated before sending then .GetInspector will act as .Display, except for not displaying. The idea is usually associated with generating default signatures especially when the flash associated with display is annoying.

Sub Send_With_Signature_Demo()

    Dim OutApp As Object
    Dim OutMail As Object

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

    With OutMail

        .To = "myaddress@somewhere.com"
        .Subject = Format(Now(), "dd/mm/yyyy")

        ' If you have a default signature
        ' you should find you need either .GetInspector or .Display
        .GetInspector
        .Save

        .Send

    End With

StopMacro:
    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub