Hallo zusammen,
ich hab folgende zwei Fragen:
1. Bei dem Befehl "Call notesMIMEEntity.SetContentFromBytes( stream, contentType, encoding )" muss ja der contentType angegeben werden. Gibt es hierzu eine Liste, welche verschiedenen Typen es gibt? Also application/pdf, image/bmp etc...
2. Ich erstelle mit VBA eine Email im HTML-Format mit Anhängen. Dies klappt jetzt auch soweit so gut, nur passen die Namen der einzeönen Anhänge nicht. D.h. Sie entsprechen nicht dem Dateinamen, sondern heißen z.b. "application-xlsx-attachment" bei einer Excel-Datei und nicht "xyz.xlsx". Ich verwende folgenden Code:
Sub LotusMail(Empfaenger As String, Inhalt As String, Absender As String,
Betreff As String, CC As String, BCC As String, Anhang As Variant, Zeile As
Integer)
Dim server As String, mailfile As String
Dim session As Object
Dim DB As Object
Dim doc As Object
Dim alleAnhänge As Variant
' Auslesen der Mail-DB
Set session = CreateObject("Notes.NotesSession")
session.ConvertMime = False
server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)
Set DB = session.GETDATABASE(server, mailfile)
Set doc = DB.CreateDocument()
doc.Form = "Memo"
doc.SendTo = Empfaenger ' Adressdaten übergeben
doc.CopyTo = Split(CC, ";") 'CC
doc.BlindCopyTo = Split(BCC, ";") ' BCC
doc.Subject = Betreff 'Betreff
Set body = doc.CreateMIMEEntity
Set bodyChild = body.CreateChildEntity()
Set stream = session.CreateStream
Call stream.Writetext(Inhalt)
Call bodyChild.SetContentFromText(stream, "text/html;charset=iso-8859-1",
1729)
Call stream.Close
Call stream.Truncate
alleAnhänge = Split(Anhang, ";")
' Pfade der Anhänge bearbeiten und hinzufügen
For i = 0 To UBound(alleAnhänge)
strAnhang = alleAnhänge(i)
If Len(strAnhang) > 0 And Len(Dir(strAnhang)) > 0 Then
' Name des Anhangs aus dem Pfad extrahieren
Position = InStrRev(strAnhang, "\")
Dateiname = Right(strAnhang, Len(strAnhang) - pos)
'Neues Child-Element des body für einen Anhang
Set bodyChild = body.CreateChildEntity()
Set Header = bodyChild.CreateHeader("Content-Type")
Call Header.SetHeaderVal("multipart/mixed")
Set Header = bodyChild.CreateHeader("Content-Disposition")
Call Header.SetHeaderVal("attachment; filename=" & Dateiname)
Set Header = bodyChild.CreateHeader("Content-ID")
Call Header.SetHeaderVal(Dateiname)
Set stream = session.CreateStream()
If stream.Open(strAnhang, "binary") Then
Dateityp = Split(alleAnhänge(i), ".")
Dateityp = "application/" & Dateityp(UBound(Dateityp))
Call bodyChild.SetContentFromBytes(stream, Dateityp, 1730)
End If
End If
Next
Call stream.Close
Call stream.Truncate
'doc.SAVEMESSAGEONSEND = True
doc.principal = Absender 'Absender
Call doc.Send(False) 'Email senden
'Variablen leeren
session.ConvertMime = True
Set doc = Nothing
Set DB = Nothing
End Sub
Wäre super wenn mir jemand auf die Sprünge helfen köönte :-)
Vielen Dank im Voraus!!
VG Dennis
Hey Roland,
vielen Dank für die Anmerkung.
Mein fertiger Code so wie folgt aus. Könntest du oder jemand anders bitte mal drüber schauen, ob da irgendwelche groben schnitzer drin sind?
Sub LotusMail(Empfaenger As String, Inhalt As String, Absender As String,
Betreff As String, CC As String, BCC As String, Anhang As Variant, Zeile As
Integer)
Dim server As String, mailfile As String
Dim session As Object
Dim DB As Object
Dim doc As Object
Dim alleAnhänge As Variant
' Auslesen der Mail-DB
Set session = CreateObject("Notes.NotesSession")
session.ConvertMime = False
server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)
Set DB = session.GETDATABASE(server, mailfile)
Set doc = DB.CreateDocument()
Set body = doc.CreateMIMEEntity
Set bodyChild = body.CreateChildEntity()
Set stream = session.CreateStream
Call stream.Writetext(Inhalt)
Call bodyChild.SetContentFromText(stream, "text/html;charset=iso-8859-1",
1729)
Call stream.Close
Call stream.Truncate
alleAnhänge = Split(Anhang, ";")
' Pfade der Anhänge bearbeiten und hinzufügen
For i = 0 To UBound(alleAnhänge)
strAnhang = alleAnhänge(i)
If Len(strAnhang) > 0 And Len(Dir(strAnhang)) > 0 Then
' Name des Anhangs aus dem Pfad extrahieren
Position = InStrRev(strAnhang, "\")
Dateiname = Right(strAnhang, Len(strAnhang) - Position)
'Neues Child-Element des body für einen Anhang
Set bodyChild = body.CreateChildEntity()
Set Header = bodyChild.CreateHeader("Content-Type")
Call Header.SetHeaderVal("multipart/mixed")
Set Header = bodyChild.CreateHeader("Content-Disposition")
Call Header.SetHeaderVal("attachment; filename=" & Dateiname)
Set Header = bodyChild.CreateHeader("Content-ID")
Call Header.SetHeaderVal(Dateiname)
Set stream = session.CreateStream()
If stream.Open(strAnhang, "binary") Then
Dateityp = Right(Dateiname, Len(Dateiname) - InStrRev
(Dateiname, "."))
'Auswahl des Dateitypes
If Dateityp Like "xls*" Then
Dateityp = "application/vnd.ms-excel"
Else
If Dateityp Like "doc*" Then
Dateityp = "application/msword"
Else
If Dateityp Like "ppt*" Then
Dateityp = "application/vnd.ms-powerpoint"
Else
If Dateityp Like "pdf" Then
Dateityp = "application/pdf"
Else
If Dateityp = "bmp" Then
Dateityp = "image/bmp"
Else
If Dateityp = "jpeg" Then
Dateityp = "image/jpeg"
Else
If Dateityp = "gif" Then
Dateityp = "image/gif"
Else
Dateityp =
"application/octet-stream"
End If
End If
End If
End If
End If
End If
End If
Call bodyChild.SetContentFromBytes(stream, Dateityp, 1730)
End If
End If
Next
Call stream.Close
Call stream.Truncate
Call doc.CloseMIMEEntities(True)
doc.Form = "Memo"
doc.SendTo = Empfaenger ' Adressdaten übergeben
doc.CopyTo = Split(CC, ";") 'CC
doc.BlindCopyTo = Split(BCC, ";") ' BCC
doc.Subject = Betreff 'Betreff
doc.principal = Absender 'Absender
'doc.SAVEMESSAGEONSEND = True
Call doc.Send(False) 'Email senden
'Variablen leeren
session.ConvertMime = True
Set doc = Nothing
Set DB = Nothing
End Sub
Vielen Dank!!
VG
Dennis
Hallo Dennis,
kleine Anmerkung am Rande...ich würde dich bitten, beim posten von längerem Code die Formatierung beizubehalten. Hier nochhmal dein Code, etwas sauberer formatiert (für den nächsten der vielleicht noch drüber schaut). Es macht sonst echt keinen Spaß zum lesen
Sub LotusMail(Empfaenger As String, Inhalt As String, Absender As String, Betreff As String, CC As String, BCC As String, Anhang As Variant, Zeile As Integer)
Dim server As String, mailfile As String
Dim session As Object
Dim DB As Object
Dim doc As Object
Dim alleAnhänge As Variant
' Auslesen der Mail-DB
Set session = CreateObject("Notes.NotesSession")
session.ConvertMime = False
server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)
Set DB = session.GETDATABASE(server, mailfile)
Set doc = DB.CreateDocument()
Set body = doc.CreateMIMEEntity
Set bodyChild = body.CreateChildEntity()
Set stream = session.CreateStream
Call stream.Writetext(Inhalt)
Call bodyChild.SetContentFromText(stream, "text/html;charset=iso-8859-1",1729)
Call stream.Close
Call stream.Truncate
alleAnhänge = Split(Anhang, ";")
' Pfade der Anhänge bearbeiten und hinzufügen
For i = 0 To UBound(alleAnhänge)
strAnhang = alleAnhänge(i)
If Len(strAnhang) > 0 And Len(Dir(strAnhang)) > 0 Then
' Name des Anhangs aus dem Pfad extrahieren
Position = InStrRev(strAnhang, "\")
Dateiname = Right(strAnhang, Len(strAnhang) - Position)
'Neues Child-Element des body für einen Anhang
Set bodyChild = body.CreateChildEntity()
Set Header = bodyChild.CreateHeader("Content-Type")
Call Header.SetHeaderVal("multipart/mixed")
Set Header = bodyChild.CreateHeader("Content-Disposition")
Call Header.SetHeaderVal("attachment; filename=" & Dateiname)
Set Header = bodyChild.CreateHeader("Content-ID")
Call Header.SetHeaderVal(Dateiname)
Set stream = session.CreateStream()
If stream.Open(strAnhang, "binary") Then
Dateityp = Right(Dateiname, Len(Dateiname) - InStrRev(Dateiname, "."))
'Auswahl des Dateitypes
If Dateityp Like "xls*" Then
Dateityp = "application/vnd.ms-excel"
ElseIf Dateityp Like "doc*" Then
Dateityp = "application/msword"
ElseIf Dateityp Like "ppt*" Then
Dateityp = "application/vnd.ms-powerpoint"
ElseIf Dateityp Like "pdf" Then
Dateityp = "application/pdf"
ElseIf Dateityp = "bmp" Then
Dateityp = "image/bmp"
ElseIf Dateityp = "jpeg" Then
Dateityp = "image/jpeg"
ElseIf Dateityp = "gif" Then
Dateityp = "image/gif"
Else
Dateityp ="application/octet-stream"
End If
Call bodyChild.SetContentFromBytes(stream, Dateityp, 1730)
End If
End If
Next
Call stream.Close
Call stream.Truncate
Call doc.CloseMIMEEntities(True)
doc.Form = "Memo"
doc.SendTo = Empfaenger ' Adressdaten übergeben
doc.CopyTo = Split(CC, ";") 'CC
doc.BlindCopyTo = Split(BCC, ";") ' BCC
doc.Subject = Betreff 'Betreff
doc.principal = Absender 'Absender
'doc.SAVEMESSAGEONSEND = True
Call doc.Send(False) 'Email senden
'Variablen leeren
session.ConvertMime = True
Set doc = Nothing
Set DB = Nothing
End Sub
Was mir aufgefallen ist:
> Call Header.SetHeaderVal("attachment; filename=" & Dateiname)
Dateiname darf nur "normale" Zeichen enthalten, habe meinen Artikel entsprechend ergänzt, wie man Umlaute encoden müsste.
> Set Header = bodyChild.CreateHeader("Content-Type")
> Call Header.SetHeaderVal("multipart/mixed")
dieser Header sollte ganz nach oben an den Body (in meiner Klasse rootMime)
> Set Header = bodyChild.CreateHeader("Content-ID")
Eine Content-ID ist nur bei multipart/related erforderlich (um z.B. im HTML darauf zu verweisen)
Ansonsten hab ich keine Schnitzer bzgl. MIME-Handling mehr gesehen.
Gruß
Roland