Insert Tables and Charts in Outlook before Default Signature from Excel

Question

I currently built a macro that pulls data from multiple files, puts pertinent data into 2 different tables and builds a Day over Day chart. I need assistance with finishing my automation by putting everything into an email and sending it off. I can get text and tables to go into an email before my signature, but I am having an issue with the Chart, it wants to go under the signature.

I started with this YouTube video to get an understanding of how to move a chart from Excel to Outlook. I have tried to implement a few solutions from SO from these solutions Insert default signature after inserting a table of data from an Excel sheet. This worked with the exception of my company’s logo shows as a red x with error ”The Linked image cannot be displayed. The file may have been moved, renamed, or deleted. Verify the link points to the correct file and location. So I tried to implement this one Add signature with images to the Mail and that resulted in the same outcome. I also tried to implement this Adding a Chart as part of the body

Option Explicit

Sub MailChart()

'declare Outlook Variables
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outIns As Outlook.Inspector

Dim strTo As String: strTo = "Distro List"
Dim strSubj As String: strSubj = "Summarized and DoD counts"
Dim strBody As String: strBody = "<html> <BODY style='font-family:Calibri (Body);font-size:11pt'>"
Dim strSign As String
Dim strSignPath As String: strSignPath = "C:\Users\UserID\AppData\Roaming\Microsoft\Signatures\Charter.htm"
Dim strGraph As String
Dim emailBody As String: emailBody = " "

'declare Word Variables
Dim outDoc As Word.Document
Dim outRng As Word.Range

'declare excel varaiabe
Dim ChrObj As ChartObject
Dim oWB As Workbook: Set oWB = ThisWorkbook
Dim oWS_Out As Worksheet: Set oWS_Out = oWB.Sheets("Output")
Dim oWS_Graph As Worksheet: Set oWS_Graph = oWB.Sheets("Graph")
Dim lngLR_T1 As Long: lngLR_T1 = oWS_Out.Range("B1").End(xlDown).Row
Dim lngLR_T2 As Long: lngLR_T2 = get_lr(2, oWS_Out)

Set outApp = GetObject(, "Outlook.Application")

'create a reference to the chart we want to copy
Set ChrObj = oWS_Graph.ChartObjects(1)
    ChrObj.Chart.ChartArea.Copy
   
'create new email
Set outMail = outApp.CreateItem(olMailItem)

If Dir(strSignPath) <> "" Then
    strSign = GetBoiler(strSignPath)
Else
    strSign = ""
End If

With outMail
    .Display
   ' strSign = .HTMLBody                     'Attempt to copy email signature only
    .HTMLBody = emailBody
    
    'get the active inspector of the email
    Set outIns = .GetInspector
    Set outDoc = outIns.WordEditor
    
    'define a range we want to paste the range in
    Set outRng = outDoc.Application.ActiveDocument.Content
        
    With outRng
        .InsertAfter " " & vbCrLf
        .Collapse Direction:=wdCollapseEnd
        .Paste
    End With

    strGraph = .HTMLBody                    'Attempt to copy the Graph
    .Close False
    
End With

strBody = strBody + "<br></br>"
strBody = strBody + "Good morning,"
strBody = strBody + "<br><br>"
strBody = strBody + "Description of data line here"
strBody = strBody + "<br>"
strBody = strBody + RangetoHTML(oWS_Out.Range("B3:E" & lngLR_T1))
strBody = strBody + "<br>"
strBody = strBody + "Volume of Tickets here:"
strBody = strBody + "<br>"
strBody = strBody + RangetoHTML(oWS_Out.Range("B" & lngLR_T1 + 3 & ":E" & lngLR_T2))
strBody = strBody + "<br>"
strBody = strBody + "DoD Created Volume"
strBody = strBody + "<br>"
strBody = strBody + strGraph '**** Graph to go here ****
strBody = strBody + "<br>"
strBody = strBody + "Regards,"

'Assemble it all
With outMail
    .Display
    .To = strTo
    .Subject = strSubj
    .HTMLBody = strBody & strSign  'vbCrLf & strGraph & vbCrLf & "<br><br>" & "Regards," &
    .Display
End With


End Sub

Let me know if you need the Functions for get_lr , GetBoiler or RangetoHTML and I will edit the post to include them. I am not sure if this matters but I am using the desktop versions of Excel and Outlook 365. Thanks for your time.

Insert Tables and Charts in Outlook before Default Signature from Excel

0 Answers0