Bild in Email einfügen

Hallo Larissa,
leider ist Deine Aussage "plötzlich nicht mehr" und der Makroschnipsel nicht sehr aussagekräftig.
Ich stand vor einiger Zeit nach dem Umstieg von Office 2007 auf Office 365 vor dem Problem, dass Bilder aus Dateien nicht mehr eingebettet wurden, sondern nur noch als Referenz in der Mail geführt wurden. Mit dem Ergebnis, dass nach Mail-Versand die Bilder nicht mehr vorhanden waren, weil der Bezug zur Ursprungsquelle fehlte.
Falls dies Dein Problem sein sollte, hier mal ein Ansatz, wie Du das lösen könntest:

Sub eMail()

Dim olkPA As Object, Pfad As String, Datei As String, sText As String

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"

Pfad = "C:\Users\Promo Plüsch\Desktop\Christian\Fotos\CM_em.JPG" 'Aus Zelle B3

Datei = Mid(Pfad, InStrRev(Pfad, "\") + 1) 'Dateinamen extrahieren

With CreateObject("Outlook.Application").CreateItem(0)

 With .Attachments

   Set olkPA = .Add(Pfad).PropertyAccessor   'Imagedatei als Anhang hinzufügen

   olkPA.SetProperty PR_ATTACH_CONTENT_ID, Datei 'Imagedatei hidden mit cid verknüpfen

 End With

  sText = sText & "&LT;img src=""cid:" & Datei & """&GT;" 'Imagedatei in Mailtext aufnehmen

  .htmlbody = sText

  .display

End With

End Sub

VBA=>HTML, (c) 2018 by KHV

viele Grüße
Karl-Heinz

Oh entschuldigung, ich habe gar nicht bemerkt, dass der Code sich nach dem Veröffentlichen verändert hat. Auf meinem Rechner ist Office Professional Plus 2013 installiert, aber das konnte ich hier im Forum nicht auswählen. Ich dachte, 2013 Office 365 ist das gleiche, was Excel angeht. Ich habe die Version aber nicht geändert, deshalb ist der Lösungsvorschlag von Karl-Heinz vielleicht nicht richtig. Deshalb füge ich jetzt einfach mal den ganzen Code ein, damit es klarer wird:


Sub Email_mit_Anhang()
Dim sSheet As String
Dim sText As String
Dim sTo As String
Dim sSubject As String
Dim sAttach As String
Dim lRow As Long
Dim myRng As Range
With ActiveSheet
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
sSubject = Sheets("Text").Range("A2").Value 'Betreff
For Each myRng In .Range(.Cells(2, 1), .Cells(lRow, 1))
If myRng.Value = "x" Then
sTo = .Cells(myRng.Row, 11).Value 'Emailadresse
sText = ""
sText = sText & .Cells(myRng.Row, 6) & "

" 'Anrede
sText = sText & Sheets("Text").Range("B2").Value 'Emailtext
'Bild
sText = sText & ""
sText = sText & "" & "

sText = sText & Sheets("Text").Range("B4").Value 'Emailtext
sAttach = .Cells(myRng.Row, 13)
Call SendMailOutlook(sSubject, sTo, sText, sAttach) 'verschicken
End If
Next myRng
End With
End Sub

Merkwürdig, die Zeile mit dem Bild hat sich schon wieder verändert.
Gut, dann lade ich auch noch die komplette Mappe hoch, da sollte es doch für Euch zu sehen sein, richtig?
https://www.herber.de/bbs/user/126367.xlsm

Forumthread: Bild in Email einfügen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial