Einbetten mehrerer Bilder in eine E-Mail mit VBA von Excel nach Outlook und Verwendung von CID

Question

Ich versuche, mehrere Grafiken (als PNGs) von einem Excel-VBA-Makro nach Outlook einzubetten. Die Bilder einbetten, aber es sind nicht alle 8 Bilder, sondern das erste Mal 8 mal wiederholt.

Sub Test() 
    Dim sheetNumber, size, i As Integer 
    Dim chartNames(), FNames() As String 
    Dim objChrt As ChartObject 
    Dim myChart As Chart 


    'Activate Charts Sheet 
    Sheets("GRAFICAS").Activate 
    'Calculate Number of Charts in Sheet 
    chartNumber = ActiveSheet.ChartObjects.Count 
    'Redimension Arrays to fit all Chart Export Names 
    ReDim chartNames(chartNumber) 
    ReDim FNames(chartNumber) 
    'Loops through all the charts in the GRAFICAS sheet 
    For i = 1 To chartNumber 
     'Select chart with index i 
     Set objChrt = ActiveSheet.ChartObjects(i) 
     Set myChart = objChrt.Chart 
     'Generate a name for the chart 
     chartNames(i) = "myChart" & i & ".png" 

     On Error Resume Next 
     Kill ThisWorkbook.Path & "\" & chartNames(i) 
     On Error GoTo 0 
     'Export Chart 
     myChart.Export Filename:=Environ$("TEMP") & "\" & chartNames(i), Filtername:="PNG" 
     'Save path to exported chart 
     FNames(i) = Environ$("TEMP") & "\" & chartNames(i) 
    Next i 
    'Declare the Object variables for Outlook. 
    Dim objOutlook As Object 
    'Verify Outlook is open. 
    On Error Resume Next 
    Set objOutlook = GetObject(, "Outlook.Application") 
    'If Outlook is not open, end the Sub. 
    If objOutlook Is Nothing Then 
     Err.Clear 
     MsgBox _ 
     "Cannot continue, Outlook is not open.", , _ 
     "Please open Outlook and try again." 
     Exit Sub 
    'Outlook is determined to be open, so OK to proceed. 
    Else 
     'Establish an Object variable for a mailitem. 
     Dim objMailItem As Object 
     Set objMailItem = objOutlook.CreateItem(0) 
     'Build the mailitem. 
     Dim NewBody As String 
      On Error Resume Next 
      With objMailItem 
       .To = "dummy@test.com" 
       .Subject = "Testing Lesson 31 email code" 
       .Importance = 1 'Sets it as Normal importance (Low = 0 and High = 2) 
       'Change the Display command to Send without reviewing the email. 
       ' .Display 
      End With 
      For i = 1 To chartNumber 
       objMailItem.Attachments.Add FNames(i) 
       'Put together the HTML to embed 
       NewBody = NewBody + HTMLcode & "<div align=center>" & "<IMG src=cid: myChart" & i & ".png></img>" & "</div>" 
      Next 
      MsgBox NewBody 
       'Set the HTML body 
       objMailItem.HTMLBody = NewBody 
       'Display email before sending 
       objMailItem.Display 
    'Close the If block. 
    End If 
     Kill Fname 
End Sub 

MsgBox NewBody Ausgänge:

und die letzte E-Mail wie folgt aussieht:

Es Alle Charts untereinander man zeigen, sollte jedoch nur es dauert myChart1. png und wiederholt es 8 mal, trotz der Ausgabe von NewBody.

Was mache ich falsch? Ich verwende Outlook 2013 und Excel 2013

UPDATE: Ich fügte ein anderes Bild hinzu und es scheint, in diesem Fall, das letzte Bild zu wiederholen, das ich 9mal hinzufügte (selbe wie Zahl der beigefügten Bilder). Ich vermute, es ist ein Problem mit der CID, vielleicht sind IDs nicht einzigartig?

Answer 1

Sie müssen die PR_ATTACH_CONTENT_ID Eigenschaft auf die Anlage entsprechend gesetzt, den Wert des cid Attribut übereinstimmen:

Set attach = objMailItem.Attachments.Add(FNames(i)) 
'Put together the HTML to embed 
Dim cid 
cid = "myChart" & i & ".png" 
NewBody = NewBody + HTMLcode & "<div align=center>" & "<IMG src=cid:" & cid & "</img>" & "</div><br><br>" 
    Call attach.PropertyAccessor.SetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F", cid)