Das Notes Forum
Domino 9 und frühere Versionen => ND8: Entwicklung => Thema gestartet von: mweitzel am 26.01.16 - 08:30:36
-
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?
-
Der übliche Weg geht in @Formelsprache so:
http://atnotes.de/index.php/topic,46637.0.html
Andreas
-
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
-
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
-
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
-
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