Domino 9 und frühere Versionen > ND7: Entwicklung

Problem mit Anhängen

(1/3) > >>

C_T:
HI@all

habe da mal wieder ein Problem. Habe schon im Forum gesucht aber keine plausible Lösung gefunden.

Ich habe ein Dokument(Doc) mit einem RichTextFeld(RTF). In dieses RTF wird per Code beim PostOpen mit Werten gefüllt. Diese Werte werden aus Dokumenten die sich auch in der gleichen DB befinden gezogen.

Der ImportScript:

--- Code: ---Sub EntwProzKom(uidocu As NotesUIDocument)
REM Normale Deklaration
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim uidoc2 As NotesUIDocument
Dim doc2 As NotesDocument
Dim db As NotesDatabase
Dim item As NotesItem

REM Mail Deklarationen
Dim DocSend As NotesDocument
Dim rtitem As NotesRichTextItem
Dim richStyle As NotesRichTextStyle

Set richStyle = session.CreateRichTextStyle



REM Setzten der Standardwerte
Set uidoc2 = uidocu
Set db = session.CurrentDatabase
Set doc2 = uidoc2.Document
Set richStyle = session.CreateRichTextStyle
Set DocSend = New NotesDocument(db)
Set rtitem = New NotesRichTextitem(DocSend, "rtbody")

Dim commonuser As String
commonuser = session.CommonUserName

REM Sonstiges
Dim Schluessel As String


REM \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     CODE     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/     \/

doc2.saveoptions = "0"
Dim view As NotesView
Dim view4 As NotesView
Dim doc3 As NotesDocument
Dim entry As NotesViewEntry
Dim vc As NotesViewEntryCollection
Dim dc As NotesDocumentCollection
Dim doc4 As NotesDocument

Set view = db.GetView("aProtokoll")

For i = 1 To 2
'Deklarationen

If i = 1 Then
Set rtbody = New NotesRichTextItem(doc2, "RTFELD")
Schluessel = Cstr(doc2.Projektnummer(0))&"Entwicklungsprozess"
Else
Set rtbody = New NotesRichTextItem(doc2, "RTFELD_1")
Schluessel = Cstr(doc2.Projektnummer(0))&"Produktionsversuch"
End If

Call view.Refresh

Set vc = view.GetAllEntriesByKey(Schluessel)
Set entry = vc.GetFirstEntry

Set view4 =db.Getview("ProtSort")
If Not view4 Is Nothing Then
If view4.IsFolder Then
Set collection = view4.AllEntries
If collection.count>0 Then Call collection.RemoveAllFromFolder( "protsort" )
End If
End If

Set dc = view.GetAllDocumentsByKey(schluessel , True)

Call dc.PutAllInFolder("protsort")

Call view4.Refresh
Set doc4 = view4.GetFirstDocument



If Not entry Is Nothing Then
Set doc3 = entry.Document 'col.GetNextDocument(doc2)


Do Until doc3 Is Nothing

'Texte einfügen
If doc4.UniversalID = doc3.UniversalID Then
richStyle.NotesColor = COLOR_RED
Call rtbody.AppendStyle(richStyle)
End If

Call rtbody.appendtext(doc3.Created)
Call rtbody.AddTab(1)

richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText(doc3.PS(0))
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)

Call rtbody.AddNewline(1)
Call rtbody.AddTab(3)
richstyle.Italic = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText(Cstr(doc3.Autor(0)))
richstyle.Italic = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(2)
Call rtbody.AppendText(doc3.Protokoll(0))

Dim anhange As NotesRichTextItem
Set Anhange = doc3.GetFirstItem("Anhange")
If Not Isempty(anhange.EmbeddedObjects)  Or Not (doc3.anhange = "" Or doc3.anhange = " ") Then
Call rtbody.AddNewline(2)
richstyle.FontSize = 8
richstyle.Underline = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Anhänge:")
richstyle.FontSize = 10
richstyle.Underline = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(1)


End If

Call rtbody.AppendRTItem(Anhange)
If doc4.UniversalID = doc3.UniversalID Then
richStyle.NotesColor = COLOR_BLACK
Call rtbody.AppendStyle(richStyle)
End If

Set entry = vc.GetNextEntry(entry)
If Not entry Is Nothing Then
Call rtbody.AddNewline(1)
Call rtbody.AppendText("-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------")
Call rtbody.AddNewline(1)
Set doc3 = entry.Document 'col.GetNextDocument(doc2)
Else
Set doc3 = Nothing
End If
Loop
End If
Next
End Sub
--- Ende Code ---

Mein Problem ist nun das wenn ich ein "Unterdokument" (das aus dem die werte für das RTF gezogen werden) lösche und sich in diesem Unterdokument ein Anhang befand, wird dieser Anhang anschließend weiterhin ganz unten in dem Doc angezeigt. Siehe Abbildungen.


Ich hoffe ihr habt ne Idee woran es liegt.

jBubbleBoy:
Kann man den Anhang nicht vorher löschen?

bubble

C_T:
das passiert halt alles wenn ich die "Unterdokumente" aus einer einfachen Ansicht heraus lösche.

Und über den Button "löschen" gehts grad noch nicht richtig da ich da noch nen kleines Scriptproblem mit habe.

jBubbleBoy:
Du solltest bevor das RT-Feld gefüllt wird, das alte (inklusive. Anhänge) löschen. So etwas mach ich immer mit dieser Funktion:

--- Code: ---Sub CorrectItemRemove (doc As NotesDocument, ItemName As String)
Dim ItemToRemove
Set ItemToRemove = doc.GetFirstItem (ItemName)
If ItemToRemove Is Nothing Then Exit Sub
If ItemToRemove.Type = 1 Then
Dim Embeddings
Dim ObjectToRemove As NotesEmbeddedObject
Embeddings = ItemToRemove.EmbeddedObjects
While Isarray (Embeddings)
Set ObjectToRemove = Embeddings (0)
Call ObjectToRemove.Remove
Embeddings = ItemToRemove.EmbeddedObjects
Wend
End If
Call ItemToRemove.Remove
End Sub

--- Ende Code ---

bubble

C_T:
dann muss ich doch das feld vor und nach deiner Funktion jeweils deklarieren oder?

Navigation

[0] Themen-Index

[#] Nächste Seite