Embedded Image displaying as broken link

  • I've been having a problem generating an email and embedding an image in said email. I have used the same code on a different project to accomplish the said goal in the same manner but whenever I try with this sheet I get broken links in the email. The image is a graph housed on a chart sheet (or rather 2 of them). Any help would be greatly appreciated.


    [VBA]Sub Distribute()


    Dim Ws_1 As Worksheet, Ws_2 As Worksheet, Ws_3 As Worksheet, Ws_4 As Worksheet, Ws_5 As Worksheet, _
    Ws_6 As Worksheet
    Dim MainDash As Range, InorgDash As Range, RPMDash As Range, VitDash As Range, MicroDash As Range
    Dim Dt As Date
    Dim Mt As String, Fname1 As String, Fname2 As String, PDFname As String, FileName As String
    Dim iMt As Integer



    Dim oApp As Outlook.Application
    Dim oEmail As MailItem
    Dim colAttach As Outlook.Attachments
    Dim oAttach1 As Outlook.Attachment, oAttach2 As Outlook.Attachment, oAttach3 As Outlook.Attachment


    Set oApp = CreateObject("Outlook.Application")
    Set oEmail = oApp.CreateItem(olMailItem)
    Set colAttach = oEmail.Attachments



    Set Ws_1 = Worksheets("Main Dash")
    Set Ws_2 = Worksheets("Inorg Dash")
    Set Ws_3 = Worksheets("RPM Dash")
    Set Ws_4 = Worksheets("Vit Dash")
    Set Ws_5 = Worksheets("Micro Dash")


    'pulls date of update data
    Dt = Ws_1.Range("H6").Value


    If Month(Dt) >= 10 Then
    FlNmMonth = Month(Dt)
    Else
    FlNmMonth = "0" & Month(Dt)
    End If
    If Day(Dt) >= 10 Then
    FlNmDay = Day(Dt)
    Else
    FlNmDay = "0" & Day(Dt)
    End If


    FileName = Year(Dt) & "-" & FlNmMonth & "-" & FlNmDay
    PDFname = Environ$("temp") & "\" & "EV KPI Update " & FileName & ".pdf"



    'this is the charts being named exported
    Fname1 = "C:\RFT Update " & FileName & ".png"
    Fname2 = "C:\TAT Update " & FileName & ".png"


    Charts("RFT").Activate
    ActiveChart.Export FileName:=Fname1, filtername:="PNG"
    Charts("TAT").Activate
    ActiveChart.Export FileName:=Fname2, filtername:="GIF"


    Set oAttach1 = colAttach.Add(Fname1)
    Set oAttach2 = colAttach.Add(Fname2)



    'save pdf to temp file for email distribution
    With Ws_1
    Worksheets(Array("Main Dash", "Inorg Dash", "RPM Dash", "Vit Dash", "Micro Dash")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFname, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With

    Set oAttach3 = colAttach.Add(PDFname)
    oEmail.Close olSave


    'Create Mail Item and display it
    With oEmail
    .To = "[email protected]"
    '.CC =
    .Subject = "Evv KPI Update " & FileName
    .HTMLBody = "<Basefont face = 'Calibri' size = '3'>Please find the KPI dashboard updates for " & FileName & " attached.</font>" _
    & "<br><br><img src='cid:RFT Update " & FileName & ".png' width=400></img>" & "<br><img src='cid:TAT Update " & FileName & ".gif' width=400></img>"
    .Display
    '.Save
    End With


    Set oEmail = Nothing
    Set colAttach = Nothing
    Set oAttach1 = Nothing
    Set oAttach2 = Nothing
    Set oAttach3 = Nothing
    Set oApp = Nothing



    Ws_1.Select


    Kill PDFname
    Kill Fname1
    Kill Fname2


    End Sub[/VBA]

  • I was able to get it working by changing the image names to a fixed name and referenceing them in the email body instead of using the dynamic filename. Still not sure why it didn't like it though. I've cleaned up the code and am posting here if anyone wants to see.


    [VBA]Sub Distribute()


    Dim Ws_1 As Worksheet, Ws_2 As Worksheet
    Dim Dt As Date
    Dim Mt As String, Fname1 As String, Fname2 As String, PDFname As String, FileName As String, strTo As String, _
    FileNm1 As String, FileNm2 As String
    Dim iMt As Integer
    Dim oApp As Outlook.Application
    Dim oEmail As MailItem


    Application.ScreenUpdating = False


    Set oApp = CreateObject("Outlook.Application")
    Set oEmail = oApp.CreateItem(olMailItem)


    Set Ws_1 = Worksheets("Main Dash")
    Set Ws_2 = Worksheets("List")


    Dt = Ws_1.Range("H6").Value


    If Month(Dt) >= 10 Then
    FlNmMonth = Month(Dt)
    Else
    FlNmMonth = "0" & Month(Dt)
    End If
    If Day(Dt) >= 10 Then
    FlNmDay = Day(Dt)
    Else
    FlNmDay = "0" & Day(Dt)
    End If


    FileName = Year(Dt) & "-" & FlNmMonth & "-" & FlNmDay


    PDFname = Environ$("temp") & "\" & "EV KPI Update " & FileName & ".pdf"
    Fname1 = Environ$("temp") & "\" & "InSpec.jpg"
    Fname2 = Environ$("temp") & "\" & "TAT.jpg"


    Charts("%InSpec").Activate
    ActiveChart.Export FileName:=Fname1, filtername:="JPG"


    Charts("TAT").Activate
    ActiveChart.Export FileName:=Fname2, filtername:="JPG"


    'save pdf to temp file for email distribution
    With Ws_1
    Worksheets(Array("Main Dash", "Inorg Dash", "RPM Dash", "Vit Dash", "Micro Dash")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFname, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With


    'build recipient list from email list stored in LIST(J2) down
    For Each Cell In Ws_2.Range(Ws_2.Range("J2"), Ws_2.Range("J2").End(xlDown))
    strTo = strTo & Cell.Value & " ; "
    Next Cell


    msg2 = "<Basefont face = 'Calibri' size = '3'>Please find the KPI dashboard updates for " & FileName & " attached.</font><br><br>"


    'Create Mail Item and display it
    With oEmail
    .To = strTo
    '.CC =
    .Subject = "Evv KPI Update " & FileName
    .Attachments.Add Fname1
    .Attachments.Add Fname2
    .Attachments.Add PDFname
    .HTMLBody = msg2 & "<img src='cid:TAT.jpg' width=750>&nbsp<img src='cid:InSpec.jpg' width=750>"
    .Display
    '.Save
    End With


    Set oEmail = Nothing
    Set oApp = Nothing


    Ws_1.Select


    Kill PDFname
    Kill Fname1
    Kill Fname2


    End Sub
    [/VBA]