Autor Thema: Problem mit Anhängen (Gelesen 2382 mal)

C_T · « **am:** 29.08.07 - 11:12:02 »

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

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 · « **Antwort #1 am:** 29.08.07 - 11:38:27 »

Kann man den Anhang nicht vorher löschen?

bubble

C_T · « **Antwort #2 am:** 29.08.07 - 12:01:30 »

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 · « **Antwort #3 am:** 29.08.07 - 12:43:46 »

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

bubble

C_T · « **Antwort #4 am:** 29.08.07 - 13:01:17 »

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

jBubbleBoy · « **Antwort #5 am:** 29.08.07 - 13:04:52 »

Die Funktion wird mit Parametern aufgerufen!!
@para doc = das NotesDocument; Typ = NotesDocument
@para itemName = Name des Feldes; Typ = String

bubble

C_T · « **Antwort #6 am:** 29.08.07 - 13:09:15 »

stimmt hab ich übersehen

C_T · « **Antwort #7 am:** 29.08.07 - 13:24:53 »

scheint funktioniert zu haben...

C_T · « **Antwort #8 am:** 29.08.07 - 13:47:04 »

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:

Code

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?

jBubbleBoy · « **Antwort #9 am:** 29.08.07 - 14:19:17 »

Aktiviere den Debugger oder baue ein Fehlerhandling ein und schreib mal welche Zeile diesen Fehler produziert.

bubble

C_T · « **Antwort #10 am:** 29.08.07 - 14:34:51 »

mein debugger übergeht den Button

jBubbleBoy · « **Antwort #11 am:** 29.08.07 - 14:37:40 »

Dann Fehlerhandling:

Code

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

Autor Thema: Problem mit Anhängen (Gelesen 2382 mal)

C_T

Problem mit Anhängen

jBubbleBoy

Re: Problem mit Anhängen

C_T

Re: Problem mit Anhängen

jBubbleBoy

Re: Problem mit Anhängen

C_T

Re: Problem mit Anhängen

jBubbleBoy

Re: Problem mit Anhängen

C_T

Re: Problem mit Anhängen

C_T

Re: Problem mit Anhängen

C_T

Re: Problem mit Anhängen

jBubbleBoy

Re: Problem mit Anhängen

C_T

Re: Problem mit Anhängen

jBubbleBoy

Re: Problem mit Anhängen