|
Sub InsertImageInThunderbird()
' Deklarieren Sie die Variablen
Dim objMail As Object
Dim strPath As String
Dim strBase64 As String
' Initialisieren Sie die Variablen
Set objMail = CreateObject("CDO.Message")
strPath = "C:\logo.jpg"
' Konvertieren Sie das Bild in Base64
strBase64 = EncodeBase64FromFile(strPath)
' Fügen Sie das Bild in den E-Mail-Body ein
objMail.HTMLBody = "<html><body><img src='data:image/jpeg;base64," & strBase64 & "'></body></html>"
' Konfigurieren Sie die E-Mail-Eigenschaften
With objMail.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.web.de"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "x.xx@web.de"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxx"
.Update
End With
' Senden Sie die E-Mail
objMail.Send
End Sub
Function EncodeBase64FromFile(ByVal strPath As String) As String
' Funktion zum Codieren eines Dateiinhalts in Base64
Dim objStream As Object
Set objStream = CreateObject("ADODB.Stream")
' Öffnen Sie die Datei und lesen Sie sie als Binärdaten
objStream.Type = 1 ' adTypeBinary
objStream.Open
objStream.LoadFromFile strPath
' Konvertieren Sie die Binärdaten in Base64
EncodeBase64FromFile = EncodeBase64(objStream.Read)
' Schließen Sie den Stream
objStream.Close
Set objStream = Nothing
End Function
Function EncodeBase64(ByVal arrData() As Byte) As String
' Funktion zum Codieren von Binärdaten in Base64
Dim objXML As Object
Dim objNode As Object
' Erstellen Sie ein XML-Dokument
Set objXML = CreateObject("MSXML2.DOMDocument")
Set objNode = objXML.CreateElement("b64")
' Konvertieren Sie das Byte-Array in ein Base64-Format
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
' Stream für Base64 erstellen
Dim objStream As Object
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 1 ' adTypeBinary
objStream.Open
objStream.Write objNode.nodeTypedValue
objStream.Position = 0
objStream.Type = 2 ' adTypeText
EncodeBase64 = objStream.ReadText
' Bereinigen
Set objNode = Nothing
Set objXML = Nothing
Set objStream = Nothing
End Function
Der Code scheitert hier aber an der Zeile:
EncodeBase64FromFile = EncodeBase64(objStream.Read)
Hat jemand noch eine Idee?
|