Body Feld über Schaltflächenformel füllen

[mweitzel]

Hallo,

ich versuche das Body Feld über eine Schaltflächenformel aus einem anderen Dokument füllen zu lassen.

Anbei die entsprechende Formel:

FIELD body := body;
@SetField("body";@DbLookup("":"NoCache";"":"";"Themen";subject;"Vorlage"))

Das Feld Vorlage ist ein Richtextlite Feld.

Leider kommt in dem Body Feld nichts an. Ich habe gelesen, dass der DBlookup Befehl mit Richtextfeldern nicht klar kommt.

Gibt es eine andere Chance das Vorhaben umzusetzen?

[Glombi]

Der übliche Weg geht in @Formelsprache so:

http://atnotes.de/index.php/topic,46637.0.html

Andreas

[mweitzel]

Mit den @ Funktionen kam ich nicht weiter. Daher versuchte ich unter Script eine Lösung zu finden bzw. zu bauen.

Das Script läuft auch ohne Fehlermeldung durch, aber es kommt im Feld Body kein Inhalt an und ich kann den Fehler nicht finden.

Anbei das Script incl. der benutzten Funktion:

Funktion:

Function LSDbLookup(db As NotesDatabase, vname As String, namekey As String, targetfldname As String) As String
   ' this function retrieves a document from the database (db) in a specified view
   ' this function returns the resulting value of the lookup (1st value) when  multiple values returned
   ' Note: Adjust this lookup to return this by changing function return to variant.
   '            Then return tmparray rather than the first value of the array.
   Dim lupV As NotesView               ' lookup view
   Dim lupDoc As NotesDocument      ' doc retrieved from lupV
   Dim lupItem As NotesItem            ' the field to retrieve
   Dim tmpArray As Variant               ' values of lupItem
   
   On Error Goto LUpErrorHandler
   
   Set lupV=db.GetView(vname)
   If (lupV Is Nothing) Then
      ' return nothing
      LSDbLookup=""
      Exit Function
   End If
   Set lupDoc = lupV.GetDocumentByKey(namekey, True)
   If (lupDoc Is Nothing) Then
      ' return nothing
      LSDbLookup=""
      Exit Function
   End If
   Set lupItem = lupDoc.GetFirstItem(targetfldname)
   If (lupItem Is Nothing) Then
      ' return nothing
      LSDbLookup=""
      Exit Function
   End If
   tmpArray = lupItem.Values
   LSDbLookup = tmpArray(0)
   Exit Function
   
LUpErrorHandler:
   ' return nothing
   LSDbLookup=""
   Exit Function
   
End Function

Und hier die Formel aus der Schaltfläche:

Sub Click(Source As Button)
   Dim ws As New NotesUIWorkspace
   Dim uidoc As NotesUIDocument
   Dim session As New NotesSession
   Dim doc As NotesDocument
   Dim Temp As String
   Dim DB As NotesDatabase
   Dim subj As Variant
   Dim richStyle As NotesRichTextStyle   
   Set richStyle = session.CreateRichTextStyle   
   Set uidoc = ws.CurrentDocument
   Set doc = uidoc.Document
   Call doc.Save(True,False)      
   Set db = session.CurrentDatabase
   Dim richText As New NotesRichTextItem(doc, "Body")   
   subj = doc.subject
   Call richText.AppendText(LSDbLookup(db,"Themen",subj (0) ,"Vorlage"))
   Call doc.Save(True,False)   
End Sub

[Andrew Harder]

RT Änderungen im Backend siehst Du nicht im Frontend, es sei denn Du machst etwas dagegen.

reopen: http://atnotes.de/index.php/topic,59351.0.html

[mweitzel]

Das Script sieht nun wie folgt aus und funktioniert auch wenn man das Dokument schließt und wieder öffnet.

Hat jemand einen Tipp wie ich das Script ergänzen kann, damit sich das aktuelle Dokument refresht und die Änderungen im Feld Body auch im Frontend angezeigt werden?

Das soll der Benutzer gar nicht merken.

Sub Click(Source As Button)
   Dim ws As New NotesUIWorkspace
   Dim uidoc As NotesUIDocument
   Dim session As New NotesSession
   Dim doc As NotesDocument
   Dim Temp As String
   Dim DB As NotesDatabase
   Dim subj As String
   Dim richStyle As NotesRichTextStyle   
   Dim ergebnis As Notesrichtextitem
   Set richStyle = session.CreateRichTextStyle   
   Set uidoc = ws.CurrentDocument
   Set doc = uidoc.Document
   Call doc.Save(True,False)      
   Set db = session.CurrentDatabase
   Set session = New NotesSession
   Dim richText As New NotesRichTextItem(doc, "Body")   
   subj = doc.subject (0)
   
   Dim LSDbLookup As NotesRichTextItem
   Dim lupDb As NotesDatabase            ' lookup database
   Dim lupV As NotesView               ' lookup view
   Dim lupDoc As NotesDocument         ' doc retrieved from lupV
   Dim lupItem As NotesItem            ' the field to retrieve
   Dim tmpArray As Variant               ' values of lupItem
   Dim tmprich As NotesRichTextItem
   Dim lupRich As NotesRichTextItem
   
   
   Set lupDb=session.CurrentDatabase
   If (lupDb Is Nothing) Then
      
   Else
   End If
   Set lupV=lupDb.GetView("Themen")
   If (lupV Is Nothing) Then
      
   Else
   End If
   Set lupDoc = lupV.GetDocumentByKey(subj, True)
   If (lupDoc Is Nothing) Then
      
   Else
   End If
   
   Set lupRich = lupDoc.GetFirstItem("Vorlage")
   
   
   If (lupRich Is Nothing) Then   
      
   Else
   End If
   
   Set LSDbLookup=lupRich
   
   Set ergebnis = LSDbLookup
   Call richtext.APPENDRTITEM(ergebnis)   
   Call doc.Save(True,False)   
End Sub

[mweitzel]

Hallo noch einmal,

das Script läuft nun fast perfekt. Eine Kleinigkeit bekomme ich noch nicht hin. Und zwar wird das UI Dokument geschlossen, aber es erscheint noch die Postfachmeldung ob "Gespeichert" "verworfen" oder "gesendet" werden soll.
Diese Meldung versuchte ich zu unterdrücken.
Bisher erfolglos.

Wenn ich bei der Meldung "nicht speichern" anklicke wird das UI Dokument geschlossen und es öffnet sich das Dokument mit dem gefüllten Body Feld.

Hat jemand eine Ahnung wie man diese eine Meldung noch unterdrückt?


Sub Click(Source As Button)
   Dim ws As New NotesUIWorkspace
   Dim uidoc As NotesUIDocument
   Dim session As New NotesSession
   Dim doc As NotesDocument
   Dim Temp As String
   Dim DB As NotesDatabase
   Dim subj As String
   Dim richStyle As NotesRichTextStyle   
   Dim ergebnis As Notesrichtextitem
   Set richStyle = session.CreateRichTextStyle   
   Set uidoc = ws.CurrentDocument
   Set doc = uidoc.Document
   'Call uidoc. save( )
   doc.SaveOptions = "0"
   Call uidoc.Close(True )
   'Call doc.Save(True,True)   
   Set db = session.CurrentDatabase
   Set session = New NotesSession
   Dim richText As New NotesRichTextItem(doc, "Body")   
   subj = doc.subject (0)
   
   Dim LSDbLookup As NotesRichTextItem
   Dim lupDb As NotesDatabase            ' lookup database
   Dim lupV As NotesView               ' lookup view
   Dim lupDoc As NotesDocument         ' doc retrieved from lupV
   Dim lupItem As NotesItem            ' the field to retrieve
   Dim tmpArray As Variant               ' values of lupItem
   Dim tmprich As NotesRichTextItem
   Dim lupRich As NotesRichTextItem
   
   
   Set lupDb=session.CurrentDatabase
   If (lupDb Is Nothing) Then
      
   Else
   End If
   Set lupV=lupDb.GetView("Themen")
   If (lupV Is Nothing) Then
      
   Else
   End If
   Set lupDoc = lupV.GetDocumentByKey(subj, True)
   If (lupDoc Is Nothing) Then
      
   Else
   End If
   
   Set lupRich = lupDoc.GetFirstItem("Vorlage")
   
   
   If (lupRich Is Nothing) Then   
      
   Else
   End If
   
   Set LSDbLookup=lupRich
   
   Set ergebnis = LSDbLookup
   Call richtext.APPENDRTITEM(ergebnis)   
   Call doc.Save( True, True )
   'Dim strUnid As String
   'strUnid = doc.Universalid   
   'Delete doc
   'Call uidoc.Close( True)
   Call ws.Editdocument( True, doc )
   Call doc.RemoveItem( "SaveOptions" )
End Sub