Domino 9 und frühere Versionen > ND6: Entwicklung

Attachemnts in RTFs verschieben

<< < (3/4) > >>

Axel:
Ich habe hier auf die Schnelle mal was zusammengestrickt, aus Zeitgründen aber leider nicht getestet. Die Fehlerbehandlung ist auch sehr rudimentär.


--- Code: ---Sub Click(Source As Button)

Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim object As NotesEmbeddedObject
Dim rtitem As NotesRichTextItem
Dim strFilename As String

Const strPath = "C:\Temp\"

On Error Goto ErrorHandler

Set uidoc = workspace.CurrentDocument
Set doc = uidoc.Document

'Lösen des Anhangs
Set rtitem = doc.GetFirstItem( "RTF1" )
If ( rtitem.Type = RICHTEXT ) Then
Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
strFilename = strPath & o.Source
Call o.ExtractFile( strFilename )
End If
End Forall
End If

'Anhängen der Datei
Set rtitem = doc.GetFirstItem( "RTF2" )
Set object = rtitem.EmbedObject( EMBED_ATTACHMENT, "", strFilename)

'Löschen der Datei
Kill strFilename

Ende:
Exit Sub

ErrorHandler:
Messagebox "Attachments kopieren - Fehler: " & Str$(Err) & " -> '" & Error$ & " in Zeile " & Str$(Erl) , 16, "Fehler"
Resume Ende
End Sub

--- Ende Code ---


Axel

koehlerbv:
Da das Dokument im FrontEnd geöffnet ist, die Manipulationen an RTIs aber im Backend stattfinden, sollte das Dokument noch im Backend gespeichert, im FrontEnd geschlossen und erneut geöffnet werden.

Bernhard

Axel:
Stimmt.

Dafür gibt's doch was von....

...unserem Kollegen Anton (ata)


--- Zitat ---
REM Das aktuelle Dokument schließen und wieder öffnen......
    Function ReOpen(docThis As NotesDocument) As Integer
        Dim ws As New NotesUIWorkspace
        Dim uidoc As NotesUIDocument
        Dim dbThis As NotesDatabase
        Dim unid As String
 
        ReOpen = 0
        Set dbThis = docThis.ParentDatabase
        Call docThis.Save(True , True)
        unid = docThis.UniversalID
        docThis.SaveOptions = "0" ' # ... Speicherabfrage vermeiden
        Set uidoc = ws.CurrentDocument
        Call uidoc.Close
        Set docThis = dbThis.GetDocumentByUNID(unid)
        Set uidoc = ws.EditDocument(True , docThis)
        Set docThis = uidoc.Document
        If docThis.HasItem("SaveOptions") Then 
            ' # ... das Feld SaveOptions wieder entfernen...
            docThis.RemoveItem("SaveOptions")
            Call docThis.Save( True , True )
        End If
        ReOpen = 1
        Print "Das Dokument wurde erneut geöffnet"
    End Function


--- Ende Zitat ---

Den Quelltext der Funktion fügst du mit Copy & Paste in den (Options)-Abschnitts des Hotspots oder der Maske ein.

Den Funktionsaufruf selbst machst du dann nach dem die Datei wieder angehängt wurde.


--- Code: ---...
'Anhängen der Datei
Set rtitem = doc.GetFirstItem( "RTF2" )
Set object = rtitem.EmbedObject( EMBED_ATTACHMENT, "", strFilename)

'Löschen der Datei
Kill strFilename

                 Call Reopen(doc)
....

--- Ende Code ---

Axel

MasterminD:
Funktioniert super!!!!! :D

nur leider wird der Anhang im ersten RTF nicht gelöscht.
Könntet Ihr mir da noch helfen?

cu

koehlerbv:
Dir fehlt noch ein NotesEmbeddedObject.Remove nach dem NotesEmbeddedObject.Extract.

Bernhard

Navigation

[0] Themen-Index

[#] Nächste Seite

[*] Vorherige Sete