I have a spreadsheet that records performance data for each employee each month. I have a button I click each month that runs some VBA code on selected employees data and creates an email for each employee. The email contains their performance data for the previous month but the code also creates a year to date graph which it then pastes on the email. I have 2 problems.

1. it always pastes the graph at the top of the email even though it has already got lots of text in the body of the email. How do I get it to add it to the bottom of the email?

2. If I run the code for just 1 employee the it generates the email body as I want it and adds the graph correctly (albeit at the top as mentioned above). However, when I run the code for more than 1 employee then it adds the graph to each email however the graph that is added to each email is the graph for the last employee whose email was generated. The code that creates the email sits within a loop that loops through for each employee selected. The code that creates the graph sits within this loop as it pulls each employees data into a table that the graph is made from. All I can think is that the graph that is pasted into the email is using the data that currently sits in the table on the spreadsheet rather than the data that was there at the time the graph was created. Is there a way around this if this is the case?

The main code that creates the email is below:

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim selectedMonth As String
    Dim emAddy As String
    selectedMonth = Sheets("Control Panel").Range("E4").Value

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

'generate graphs

Dim sh As Variant
Set Rng = Range("B1:M12")
For Each sh In Array("April", "May", "June", "July", "August", "September", "October", "November", "December", "January", "February", "March") 
    lastrow = Sheets(sh).Range("A" & Rows.Count).End(xlUp).Row
    For m = 1 To lastrow
        If Sheets(sh).Range("A" & m).Value = staffList.List(i) Then
            For N = 2 To 13
                If Sheets("graphs").Cells(1, N).Value = sh And Sheets(sh).Range("L" & m).Value <> "NaN" Then
                    Sheets("graphs").Cells(2, N).Value = FormatPercent(Sheets(sh).Range("L" & m).Value): N = 13
                End If
            Next N
            m = lastrow
        End If
    Next m
Next sh
    
    On Error Resume Next
    With OutMail
        .From = ""
        .To = emAddy
        .CC = ""
        .BCC = ""
        .Subject = "Monthly Stats"
        .HTMLbody = strbody
        .Display
    End With
    On Error GoTo 0

   Set mailApp = CreateObject("Outlook.Application")
    Set mail = mailApp.CreateItem(olMailItem)
    
    Set wEditor = mailApp.ActiveInspector.WordEditor
    Sheets("graphs").ChartObjects("Chart 1").Copy
    
    wEditor.Application.Selection.Paste

CodePudding user response：

You have to do a little work to make sure you have an allowable WordEditor (see this documentation) and then to move the insertion point to the end of the document. The example here shows how:

Option Explicit

Sub TestEmailWithChart()
    Dim theChart As ChartObject
    Set theChart = Sheet1.ChartObjects(1)
    theChart.CopyPicture
    
    Dim olApp As Outlook.Application
    Set olApp = New Outlook.Application
    
    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)
    
    Dim mailBody As String
    mailBody = "Hello,<br><br>Here is the chart:<br><br><br>"
    
    With olMail
        .To = "[email protected]"
        .CC = vbNullString
        .BCC = vbNullString
        .Subject = "Test Email with Chart"
        .HTMLBody = mailBody
        
        With .GetInspector
            If .IsWordMail And (.EditorType = olEditorWord) Then
                Dim mailDoc As Word.Document
                Set mailDoc = .WordEditor
                mailDoc.Application.Selection.EndKey Unit:=wdStory
                mailDoc.Application.Selection.Paste
            Else
                Debug.Print "Can't use the Word Editor for this email"
            End If
        End With
        
        .Display
    End With
End Sub