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:
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
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.
Du solltest bevor das RT-Feld gefüllt wird, das alte (inklusive. Anhänge) löschen. So etwas mach ich immer mit dieser Funktion:
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
bubble
Weiteres Problem:
bezieht sich auf das Scenario von oben und ich habe wie gesagt noch ein Problem mit dem "löschen" Button.
Der Code hinter dem Button:
Sub Click(Source As Button)
REM Normale Deklaration
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim db As NotesDatabase
REM Setzten der Standardwerte
Set uidoc = workspace.CurrentDocument
Set db = session.CurrentDatabase
Set doc = uidoc.Document
REM \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ CODE \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/
'Setzen von Werten
Dim entry As NotesViewEntry
Dim vc As NotesViewEntryCollection
Dim doc2 As NotesDocument
Schluessel = Cstr(doc.Projektnummer(0))&"Entwicklungsprozess"
flag = workspace.PickListStrings(PICKLIST_CUSTOM, False,"sassmail01","APDesignlenkung.nsf", "aProtokoll","Eintrag auswählen","Bitte wählen Sie den zu löschenden Eintrag aus!",6,Schluessel)' [, categoryname$ ] )
If Not Isempty(flag) Then
Set doc2 = db.GetDocumentByUNID(flag(0))
flag2 = workspace.Prompt(Prompt_YesNo,"Löschen?","Wollen Sie den Eintrag wirklich löschen? "+ doc2.PS(0))
If flag2 = "1" Then
doc.saveoptions=0
Call doc.Save(True,False)
doc2.Remove(True)
Call uidoc.Close
Set uidoc = workspace.EditDocument(True,doc)
End If
End If
End Sub
So das "Unterdokumen" wird auch ganz brav gelöscht, jedoch gibt er mir eine Fehlermeldung. Siehe Anhang
Kann mir da wer helfen?
Dann Fehlerhandling:
on error goto errorz
'... Hier ist dein Code ;)
goto EndeZ
ErrorZ:
dim err_msg$
err_msg$ = "Function: " & Getthreadinfo(1) & " " & Err & ": " & Error$ & " - Line " & Erl
print err_msg
Msgbox "Es ist ein Fehler ist aufgetreten!" & Chr(10) & Chr(10) & err_msg,16,"Error"
Resume EndeZ
EndeZ:
bubble