Hallo Bernhard und Th.
Vielen Dank für die Rückmeldung und Entschuldigung, war am Mittwoch nach 12 Stunden vor der Kiste völlig generved.
MIME ist mir nicht ganz unbekannt, habe schon rekursive MIME-Mailverarbeitung in Java geschrieben die funktioniert.
Das Beispieldokument hat 55 Bodyfelder Doppeleintrags-ID 0 bis 53 werden leer angezeigt, wenn ich über Dokumenteneigenschaften rein schaue 54 enthält den Text der Mail "Grüße ..."
(Im Anhang alle ausgelesenen Felder.)
In Lotusscript bekomme ich das Entity gar nicht zu fassen und finde auch nach diversen Suchen im Forum oder über Google keine Lösung.
Weisst Du, dass Inline Images in der Regel in einen "image"-Tag eingebunden sind und Base64-kodiert sind? Hast Du danach schon gesucht?
Wie komme ich an das "Image"-Tag?
doc.GetMIMEEntity ist nothing
doc.Hasembedded ist false
Isempty(rtitem.EmbeddedObjects) ist true für alle richtextitems
Evaluate("@AttachmentNames", doc) gibt auch nichts zurück
Gruß
Renate
Option Public
Option Declare
Sub Initialize
On Error Goto fehler
Print "iPhone Mail Test"
Dim session As New NotesSession
session.ConvertMime = False
Dim db As notesdatabase
Dim dc As notesdocumentcollection, doc As notesdocument, rtitem As notesrichtextitem
Dim fehler As Integer
fehler = 0
Dim docHasError As Boolean
Set db= session.currentdatabase
Dim agentLog As New NotesLog("Logbuch")
Call agentLog.Openmaillog(session.Username, "iPhone Mailtest in " + db.Title)
Call agentLog.LogAction("Start...")
Set dc = db.Unprocesseddocuments
Set doc = dc.getfirstdocument
Dim findEmbedded As Boolean
While Not doc Is Nothing
docHasError = false
findEmbedded = False
'Body
Dim hasEmbedded As Boolean
hasEmbedded = false
If doc.Hasembedded then
Call agentlog.Logaction(doc.subject(0) + " hat Embedded Objects")
hasEmbedded = True
else
Call agentlog.Logaction(doc.subject(0) + " hat keine Embedded Objects")
hasEmbedded = false
End If ' hasembedded
ForAll item In doc.Items
If ( item.Type = RICHTEXT ) Then
Call agentlog.Logaction( "item: " + item.name)
Call agentlog.Logaction( "is richtext")
Set rtitem = item
If rtitem Is Nothing Then
Call agentlog.Logaction( "rtitem Is Nothing")
Goto nextitem
End If
If Not( Isempty(rtitem.EmbeddedObjects)) Then
findEmbedded = true
Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
Call agentlog.Logaction("Objectname:" + o.name)
End If
nextFile:
End Forall
Else
Call agentLog.LogAction("Kein Object enthalten.")
End If
End If
nextitem:
End ForAll
' nächter Versuch, wenn Attachment nicht am Richtext hängen
Dim vEval As Variant
Dim embObj As NotesEmbeddedObject
vEval = Evaluate("@AttachmentNames", doc)
Call agentLog.LogAction("check @AttachmentNames")
If IsArray(vEval) then
ForAll v In vEval
If v <> "" Then
If hasEmbedded And Not findEmbedded Then
Call agentLog.LogAction("Nicht bearbeitetes Attachment =" & v)
else
Call agentLog.LogAction("enthalten Attachment:" & v)
End If
Set embObj = doc.GetAttachment(v)
End If
End ForAll
Else
If vEval <> "" Then
If hasEmbedded And Not findEmbedded Then
Call agentLog.LogAction("Nicht bearbeitetes Attachment =" & vEval)
Else
Call agentLog.LogAction("enthalten Attachment:" & vEval)
End If
End If
End if
' Iterate through each of the document's items looking for attachments
Dim objAttachment As NotesEmbeddedObject
Dim icounter As Integer
icounter = 0
Call agentlog.Logaction("Check item.type Attachment")
ForAll item In doc.Items
Call agentlog.Logaction(item.name + " itemTyp" + CStr(item.Type))
If item.Type = RFC822Text Then
Call agentlog.Logaction("RFC822Text.Name" + item.Values(0))
End If
If item.Type = Attachment Then
' first in Values array is the name of the attachment.
Set objAttachment = doc.GetAttachment(item.Values(0))
iCounter = iCounter + 1
'get the attachment filename
Call agentlog.Logaction("objAttachment.Name" + CStr(icounter)+" " + objAttachment.Name)
End If
End forall
' %REM MIME Verarbeitung
' Dim s As New NotesSession
Dim mime As NotesMimeEntity
Dim parent As NotesMimeEntity
Dim stream As NotesStream
Dim header As NotesMIMEHeader
Dim filename As String
Dim basedir As String
basedir = "c:\temp\"
Set stream = session.CreateStream
Set mime = doc.GetMIMEEntity
if Not mime Is Nothing Then
Call agentLog.LogAction("is mime")
else
Call agentLog.LogAction("is NOT mime")
End If
While Not mime Is Nothing
'if a mime part contains an attachment the Content-Disposition header will contain the value of "attachment"
Set header = mime.GetNthHeader("Content-Disposition")
If (Not header Is Nothing) Then
Call agentLog.LogAction("Has header")
If (header.GetHeaderVal(True) = "attachment") Then
'if the Content-Disposition header exists then the filename parameter must be present
filename = header.GetParamVal("filename")
'strip off the quotation marks on the file name
filename = Strright(filename, {"})
filename = Strleft(filename, {"})
'open a file, get the content of the attachment, and write it to the file system
stream.Open baseDir + filename, "binary"
mime.GetContentAsBytes stream, True
stream.Close
End If
else
Call agentLog.LogAction("header Is Nothing")
End If
Set mime = mime.GetNextEntity(SEARCH_DEPTH)
Wend
session.ConvertMime = True
' %END REM
weiter:
Set doc = dc.getnextdocument(doc)
'Stop
Wend
Ende:
If fehler > 0 then
Messagebox "Shrink Images mit Fehlern beendet. Errorcount=" + CStr(fehler) + Chr(13) + "Siehe auch Logmail"
Call agentlog.Logaction("Generate Shrink Images ended. Errorcount=" + CStr(fehler))
else
Messagebox "Shrink Images ohne Fehler beendet." + Chr(13) + "Siehe auch Logmail"
Call agentlog.Logaction( "Generate Shrink Images successfully ended")
End if
Call agentLog.LogAction("Finish...")
Call agentlog.close
Exit Sub
fehler:
fehler = fehler +1
Print "ShrinkImages ERROR:" + Str(Err) + " " + Error$(ERR) + " in Zeile " + CStr(Erl)
Call agentlog.Logaction( "ShrinkImages ERROR:" + Str(Err) + " " + Error$(ERR) + " in Zeile " + CStr(Erl) )
Err = 0
Goto weiter
End Sub
Thema: iPhone Mail mit Inlines, Inlines sichtbar, aber programmatisch nicht (Gelesen 8192 mal)