Embedded image not showing on email VBA

Question

I have some code to send an email, but the embedded image displays as a red "X". The Reference to C19 is "Image.png" (This filename changes constantly based on other data) and the filename.

The first 2 macros save the file to the downloads folder and the 3rd macro is currently outputting with a red "X".

Sub CandidCamera()

   Sheets("Total Hours Check").Range("M5").AutoFilter Field:=2, Criteria1:="<>"
   If Sheets("Total Hours Check").Range("N6") > 0 Then
   Call CapturePivottable
   Else
   MsgBox "No High Hours Reported"
   Exit Sub
   End If
End Sub

Private Sub CapturePivottable()

    Dim si As Excel.SlicerItem, siDummy As Excel.SlicerItem
    Dim pt As Excel.PivotTable
    Dim co As Excel.ChartObject
    Dim wsBlank As Excel.Worksheet

    Set pt = Sheets("Total Hours Check").PivotTables(1)

    ' add a blank sheet to get a blank Chart instead of PivotChart later
    Set wsBlank = ActiveWorkbook.Sheets.Add


        With pt.TableRange2 ' or TableRange1
            .CopyPicture Appearance:=xlScreen, Format:=xlPicture
            Set co = wsBlank.ChartObjects.Add(1, 1, .Width, .Height)
            co.Select
            co.Chart.Paste
            co.Chart.Export _
                Filename:=Environ("USERPROFILE") & "\Downloads\" & Sheets("Private").Range("B7").Value & ".png", filtername:="PNG"


            co.Delete
        End With

Call Email

    Application.DisplayAlerts = False
    wsBlank.Delete
    Application.DisplayAlerts = True

End Sub

Sub Email()


'Sends the last saved version of the Activeworkbook
    Dim OutApp As Object
    Dim OutMail As Object

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

    On Error Resume Next
    With OutMail
        .To = Worksheets("Private").Range("A19").Value
        .CC = "email1@gmail.com; "
        '.BCC = ""
        .Subject = Worksheets("Private").Range("H29").Value
        '.Body =
        .Attachments.Add ActiveWorkbook.FullName
        .Attachments.Add Filepath, olByValue, 1
            Filepath = Environ("USERPROFILE") & "\Downloads\" & Filename
            Filename = Sheets("Private").Range("C19").Value
        .HTMLBody = "<img src=cid:Filename></img>"
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")

        .Display   'or use .Send


    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Answer 1

The issue lied with the HTML Body statement. I added quotes and it's now embedding correctly.

Sub Email()


'Sends the last saved version of the Activeworkbook
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Filepath As String
    Dim Filename As String

    Filename = Sheets("Private").Range("C19").Value
    Filepath = Environ("USERPROFILE") & "\Downloads\" & Filename

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

    On Error Resume Next
    With OutMail
        .To = Worksheets("Private").Range("A19").Value
        '.BCC =
        .Subject = Worksheets("Private").Range("H29").Value
        '.Body =
        .Attachments.Add ActiveWorkbook.FullName
        .Attachments.Add Filepath, olByValue, 0
        'Change "1" value to 0 to hide
        .HTMLBody = "<img src=""" & Filepath & """>"
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")

        .Display   'or use .Send


    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub