Hallo,
ich habe mittlerweile folgenden Code zusammengestückelt:
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim collection As NotesDocumentCollection
Dim coldoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim doc2 As NotesDocument
Dim uidoc As NotesUIDocument
Dim unid As String
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set Doc2 = uidoc.Document
Set collection = ws.PickListCollection(PICKLIST_CUSTOM,True,db.Server,"lehre\StrategicMarketingIS.nsf","Person","Contacts"," " )
Set coldoc = collection.GetFirstDocument
Set rtitem = New NotesRichTextItem(Doc2, "SO_EconomicBuyer")
Call rtitem.AppendDocLink(coldoc, "Dokument")
Doc2.Form = "Sales Opportunity"
Doc2.Saveoptions = "0"
Call Doc2.Save(True, False)
unid = Doc2.UniversalID
Set Doc2 = db.GetDocumentByUNID(unid)
Set uidoc = ws.EditDocument(Doc2)
uidoc.editmode = True
End Sub
Dieser Code funktioniert soweit, jedoch wird die Mehrfachauswahl nicht beachtet. D.h. es wird -auch wenn ich mehrere Personen auswähle - nur ein Link erzeugt. Hat jemand einen Tipp, wie die Schleife aussehen müsste? Und außerdem: ist das Skript effizient und sauber? Hat jemand Verbesserungsvorschläge?
Gruß
Björn
Hi,
die Schleife müsste so aussehen:
...
Set collection = ws.PickListCollection(PICKLIST_CUSTOM,True,db.Server,"lehre\StrategicMarketingIS.nsf","Person","Contacts"," " )
Set coldoc = collection.GetFirstDocument
Set rtitem = New NotesRichTextItem(Doc2, "SO_EconomicBuyer")
While Not (coldoc Is Nothing)
Call rtitem.AppendDocLink(coldoc, "Dokument")
Call rtitem.AddNewLine(1) 'Einfügen einer Zeilenschaltung
Set coldoc = collection.GetNextDocument(coldoc)
Wend
Doc2.Form = "Sales Opportunity"
...
So auf den ersten Blick ist am Code nichts auszusetzen.
Axel
Hi,
das mit den RTF-Felder ist so eine Sache. In manchen Fällen verhalten sich die Dinger etwas störrisch.
Unser Forumsmitglied ata (Alias Anton Tauscher) hat auf seiner Webseite eine Funktion, die dein Problem löst.
REM Das aktuelle Dokument schließen und wieder öffnen......
Function ReOpen(docThis As NotesDocument) As Integer
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim dbThis As NotesDatabase
Dim unid As String
ReOpen = 0
Set dbThis = docThis.ParentDatabase
Call docThis.Save(True , True)
unid = docThis.UniversalID
docThis.SaveOptions = "0" ' # ... Speicherabfrage vermeiden
Set uidoc = ws.CurrentDocument
Call uidoc.Close
Set docThis = dbThis.GetDocumentByUNID(unid)
Set uidoc = ws.EditDocument(True , docThis)
Set docThis = uidoc.Document
If docThis.HasItem("SaveOptions") Then
' # ... das Feld SaveOptions wieder entfernen...
docThis.RemoveItem("SaveOptions")
Call docThis.Save( True , True )
End If
ReOpen = 1
Print "Das Dokument wurde erneut geöffnet"
End Function
Binde diese Funktion in deinen Code ein, und dann sollte das funktionieren.
Axel
Kann mir einer einen Tipp geben, warum dies nicht funktioniert?
Dim fullname As NotesItem
Set fullname = coldoc.Items(19)
Call rtitem.AppendText(fullname)
Ziel ist eigentlich das, was ich oben beschrieben habe:
Werde jetzt noch versuchen, aus der Collection Daten zu ziehen, um so neben dem Link auch noch einen Text zu setzen. Dieser soll dynamisch generiert sein (das Skript soll aus der Collection Vor- und Nachname ziehen).
Der gesamte Code sieht jetzt so aus:
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim collection As NotesDocumentCollection
Dim coldoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim doc2 As NotesDocument
Dim uidoc As NotesUIDocument
Dim unid As String
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc2 = uidoc.Document
Set collection = ws.PickListCollection(PICKLIST_CUSTOM,True,db.Server,db.filepath,"Person","Contacts"," " )
Set coldoc = collection.GetFirstDocument
Set rtitem = New NotesRichTextItem(doc2, "SO_EconomicBuyer")
Dim fullname As NotesItem
While Not (coldoc Is Nothing)
Set fullname = coldoc.Items(19)
Call rtitem.AppendDocLink(coldoc, "Dokument")
Call rtitem.AppendText(fullname) '<-- geht nicht
Call rtitem.AddNewLine(1)
Set coldoc = collection.GetNextDocument(coldoc)
Wend
Call ReOpen(doc2)
End Sub
Danke und Gruß
Björn
Hallo auch,
also folgender Code führt zum gewünschten Ergebnis:
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim collection As NotesDocumentCollection
Dim coldoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim doc2 As NotesDocument
Dim uidoc As NotesUIDocument
Dim unid As String
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc2 = uidoc.Document
Set collection = ws.PickListCollection(PICKLIST_CUSTOM,True,db.Server,db.filepath,"Person","Contacts"," " )
Set coldoc = collection.GetFirstDocument
Set rtitem = New NotesRichTextItem(doc2, "SO_EconomicBuyer")
Dim strfullname As String
While Not (coldoc Is Nothing)
strfullname = coldoc.FirstName(0) & " " & coldoc.LastName(0)
Call rtitem.AppendDocLink(coldoc, "Dokument")
Call rtitem.AppendText(strfullname)
Call rtitem.AddNewLine(1)
Set coldoc = collection.GetNextDocument(coldoc)
Wend
Call ReOpen(doc2)
End Sub
Funktion ReOpen:
Function ReOpen(docThis As NotesDocument) As Integer
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim dbThis As NotesDatabase
Dim unid As String
ReOpen = 0
Set dbThis = docThis.ParentDatabase
Call docThis.Save(True , True)
unid = docThis.UniversalID
docThis.SaveOptions = "0"
Set uidoc = ws.CurrentDocument
Call uidoc.Close
Set docThis = dbThis.GetDocumentByUNID(unid)
Set uidoc = ws.EditDocument(True , docThis)
Set docThis = uidoc.Document
If docThis.HasItem("SaveOptions") Then
docThis.RemoveItem("SaveOptions")
Call docThis.Save( True , True )
End If
ReOpen = 1
End Function
Großes Danke an Axel, aber auch insgesamt danke für dieses Forum. Ihr seid Spitze!
Gruß
Björn
Hi auch,
ich habe den Code noch ein wenig geändert. Nunmehr wird der Name nicht aus einer collection gezogen, sondern aus einer Dialog List. Das Ganze habe ich in das Exiting Event gelegt. Mein Problem ist, dass der Link, der erzeugt wird, nicht funktioniert. D.h. es wird nicht zum ldoc verlinkt, sondern zum doc (klicke ich den Link, wird das Dokument erneut geladen). Was soll das? Hier der Code:
Sub Exiting(Source As Field)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim view As NotesView
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim ldoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim key As String
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc = uidoc.Document
key = doc.SO_EconomicBuyer(0)
Set view = db.GetView("Person" )
Set ldoc = view.GetDocumentByKey(key)
Set rtitem = New NotesRichTextItem(doc, "SO_EB_Link")
Call rtitem.AppendDocLink(ldoc, "Link")
Call ReOpen(doc)
End Sub
Funktion ReOpen siehe oben.
MfG und vielen Dank
Björn
Hi auch,
hab das Ganze jetzt in das Postrecalc Event gepackt. Mein Code sieht jetzt so aus:
Sub Postrecalc(Source As Notesuidocument)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim uidoc As NotesUIDocument
Dim ws As New NotesUIWorkspace
Dim doc As NotesDocument
Dim ldoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim key As Variant
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc = uidoc.Document
For i = 1 To 4
key = doc.GetItemValue(("SO_Name_" + Cstr(i)))
Set rtitem = New NotesRichTextItem(doc,("SO_Link_" + Cstr(i)))
Set view = db.GetView("Person" )
Set ldoc = view.GetDocumentByKey(key(0))
If ldoc Is Nothing Then
Exit Sub
Else
Call doc.ReplaceItemValue(("SO_Link_" + Cstr(i)),"")
Call rtitem.AppendDocLink(ldoc, "Link")
Call ReOpen(doc)
End If
Next i
End Sub
Mit der Zeile
Call doc.ReplaceItemValue(("SO_Link_" + Cstr(i)),"")
Danke und viel Spaß noch
Björn
Hi Axel und natürlich auch die anderen,
das ist eine gute Idee. Aber ich hab jetzt in der Hilfe nochmal nachgelesen und mich mit getFirstItem, GetItemValue und FieldGetText beschäftigt. Ich verstehe, welche Klassen vorausgesetzt werden. Was mich verwundert, ist das folgender Code nicht funktionsfähig ist.
Dim session As New NotesSession
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim ws As New NotesUIWorkspace
Dim doc As NotesDocument
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc = uidoc.Document
Set rtitem = doc.GetFirstItem("SO_Name_1")
Der Fehler ist: Type Mismatch in der letzten Zeile bei set rtitem. Es handelt sich doch bei doc um ein NotesDocument, welches die Methode GetFirstItem unterstützt. Ich finde in NotesUIDocument keine alternative Methode. Also, was machen? Sorry für die vielen Fragen und tausend Dank!
Gruß
Björn
Die habe ich so, wie du vorschlägst, deklariert. Habe den Code nur ausschnittsweise gepostet. Hier nochmal mein Testcode:
Sub Postrecalc(Source As Notesuidocument)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim uidoc As NotesUIDocument
Dim ws As New NotesUIWorkspace
Dim doc As NotesDocument
Dim ldoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim key As Variant
Dim counter As Integer
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc = uidoc.Document
Set rtitem = doc.GetFirstItem("SO_Name_1")
counter = uidoc.FieldGetText("EB_counter")
For i = 1 To counter
key = uidoc.FieldGetText(("SO_Name_" + Cstr(i)))
Messagebox(key)
Next i
End Sub
Gruß
Björn
Was mir aufgefallen ist, du legst immer ein neues RTF-Feld an. Vielleicht klemmts darum. Besser ist es, erstmal zu prüfen, ob es das RTF-Feld schon gibt (GetFirstItem aus der NotesDocument-Klasse). Wenn es vorhanden ist kannst du es leeren. Wenn GetFirstItem Nothing zurückliefert, kannst du ein neues anlegen.
Du meinst es klemmt an der Stelle Set rtitem = New NotesRichTextItem(doc,("SO_Link_" + Cstr(i)))
Gruß
Björn
@koehlerbv
Also ich hab in meinen letzten Posts die Felder verwechselt. Ich wollte das Feld SO_Link_1 auslesen (Typ Rich Text) und nicht das Feld SO_Name_1 (Typ Dialog List). In meinem Skript habe ich immer versucht, SO_Name_1 anzusprechen. Mein Fehler.
Ich weiß jetzt nicht genau, was du meinst. Sorry.
@All
Mittlerweile habe ich eine Methode gefunden, dass Rich Text Feld zu leeren:
Call uidoc.FieldClear(("SO_Link_" + Cstr(i)))
Sub Postrecalc(Source As Notesuidocument)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim uidoc As NotesUIDocument
Dim ws As New NotesUIWorkspace
Dim doc As NotesDocument
Dim ldoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim key As Variant
Dim counter As Integer
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc = uidoc.Document
counter = uidoc.FieldGetText("EB_counter")
For i = 1 To counter
key = uidoc.FieldGetText(("SO_Name_" + Cstr(i)))
Set rtitem = New NotesRichTextItem(doc,("SO_Link_" + Cstr(i)))
Set view = db.GetView("Person" )
Set ldoc = view.GetDocumentByKey(key)
If (key <> "") Then
If ldoc Is Nothing Then
Messagebox("Could not find document for " & key & ".")
Exit Sub
Else
Call rtitem.AppendDocLink(ldoc, "Link")
Call ReOpen(doc)
End If
Else
Call uidoc.FieldClear(("SO_Link_" + Cstr(i)))
End If
Next i
End Sub
Eigentlich funktioniert jetzt alles so, wie ich es haben wollte. Falls ihr noch was findet, bitte posten :-)
Kurze Frage noch: Gibt es noch ein alternatives Event zu Postrecalc, was für mein Skript zweckdienlich ist?
Gruß und schönes Wochenende. Sorry für meine blöden Fragen...
Beste Grüße
Björn