Hi Bernd,
Du willst es echt wissen
Wenn du das Feld nicht umbenennen musst, gehts noch relativ einfach. Da hilft dir ein CopyAllItems um ein temp-Doc zu erzeugen. Anschließend iterierst du über doc.items und löscht alle Felder bis auf das Mime-Feld und $FILE
Ansonsten musst du Mime-Part für Mime-Part kopieren. Ich hab dafür auch ein Codeschnipsel.
Ich habe aber hier eine Bitte. Untenstehender Code hat Kollegen und mich viel Arbeit gekostet und wir müssen immer wieder mal fest stellen, dass sich noch der ein oder andere Fehler eingeschlichen hat. (z.B. bei der Filterung, welche Mime-Header wir kopieren und welche nicht)
Solltest du Verbesserungen im Code machen, oder noch eine andere Möglichkeit finden wie man diese widerspenstigen Mime-Items kopiert, so wäre ich dir sehr dankbar wenn du diese im Foum wieder mitteilst.
Gruß
Roland
'/**
' * Kopiert den Inhalt einer Mime-Entity und alle untergeordneten Entitäten in eine Ziel-Entität
' * @param srcMime Mime-Quellobjekt
' * @param dstMime Mime-Zielobjekt
' * @return
' */
Private Function copyMimeWithChildren(srcMime As NotesMIMEEntity, dstMime As NotesMIMEEntity)
On Error GoTo rethrow
If False Then
rethrow: rethrow
End If
'--- Errorhandling Ende -----
Dim session As New NotesSession
Dim dstHdr As NotesMIMEHeader
Dim stream As NotesStream
Set stream = session.createStream
' also wenn mir irgenwder mal zeigen kann wie man diese $%&§§$" Mime-items einfacher kopieren kann
' dann wäre ich darüber SEHR dankbar
Dim filter(0), contentType$
filter(0)="Content-Type"
contentType = Trim(StrRight(srcMime.GetSomeHeaders(filter, True), "Content-Type:"))
' header kopieren
ForAll header In srcMime.HeaderObjects
'Msgbox header.HeaderName + ": " + header.GetHeaderValAndParams()
If header.HeaderName = "Content-Transfer-Encoding" Then
' nop
ElseIf header.HeaderName = "Content-Type" Then
' nop
ElseIf header.HeaderName Like "X-*" Then
' nop
' ElseIf header.HeaderName = "Content-ID" Then
' ' nop
Else
' If srcMime.GetParentEntity Is Nothing Then
' ' CHECKME: hier noch eine Skip-Methode einbauen bei Root-Mimes oder reicht X-*
' End If
Dim hdr As NotesMIMEHeader
Set hdr = dstMime.CreateHeader(header.HeaderName)
' MsgBox header.HeaderName + " = "+ header.GetHeaderValAndParams()
If Not hdr Is Nothing Then Call hdr.SetHeaderValAndParams( header.GetHeaderValAndParams() )
End If
End ForAll
' content kopieren
Call srcMime.getContentAsBytes( stream, False )
Call dstMime.setContentFromBytes( stream, contentType, srcMime.encoding )
Dim dstChild As NotesMIMEEntity
Dim srcChild As NotesMIMEEntity
Set srcChild = srcMime.GetFirstChildEntity
Do Until srcChild Is Nothing
Set dstChild = dstMime.createChildEntity()
Call copyMimeWithChildren( srcChild, dstChild )
Set srcChild = srcChild.GetNextSibling
Loop
End Function
Aufgerufen wird das dann so:
set src = srcDoc.getMimeEntity("AbsenderBody")
set dst = dstDoc.createMimeEntity("Body")
call copyMimeWithChildren(src,dst)
Call srcDoc.CloseMIMEEntities(False,"AbsenderBody")
Call dstDoc.CloseMIMEEntities(True,"Body")
