Hallo auch,
hier erstmal der Code:
Sub Click(Source As Button)
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
Dim fieldcounter(1 To 4) As String
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc = uidoc.Document
fieldcounter(1) = "EB_counter"
fieldcounter(2) = "UB_counter"
fieldcounter(3) = "TB_counter"
fieldcounter(4) = "Coach_counter"
For i = 1 To 4
counter = uidoc.FieldGetText((fieldcounter(i)))
For j = 1 To counter
key = uidoc.FieldGetText(("SO_Name_" + Cstr(i) + "_" + Cstr(j)))
Messagebox("i: " & i & " j: " & j)
Messagebox(key)
Set rtitem = New NotesRichTextItem(doc,("SO_Link_" + Cstr(i) + "_" + Cstr(j)))
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 uidoc.FieldClear(("SO_Link_" + Cstr(i) + "_" + Cstr(j)))
Call rtitem.AppendDocLink(ldoc, "Link")
Call ReOpen(doc)
End If
Else
Call uidoc.FieldClear(("SO_Link_" + Cstr(i) + "_" + Cstr(j)))
Call ReOpen(doc)
End If
Next j
Next i
End Sub
Wenn ich den Code ausführe, erhalte ich in der Zeile Set rtitem = New NotesRichTextItem(doc,("SO_Link_" + Cstr(i) + "_" + Cstr(j))) den Fehler "Error creating product object". Was bedeutet das? Wie kann ich Abhilfe schaffen? Hintergrundinfos zu obigem Skript gibts unter: http://www.atnotes.de/index.php?topic=24367.0
Danke und Gruß
Björn
Ich glaube, die Schleife wird gar nicht richtig durchlaufen.
Was macht denn das Call ReOpen(doc)?
Hier die 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
Wo ist das Script denn - in einem Button?
Ich habe das Skript in der Action Bar als Button hinterlegt.
Gruß
dabjoern
Hier habe ich nochmal den überarbeiteten Code (leider erscheint immer noch o.g. Fehler):
Sub Click(Source As Button)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim ldoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim key As Variant
Dim counter As Integer
Dim linkName As String
Dim feldName As String
Dim fieldcounter(1 To 4) As String
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc = uidoc.Document
fieldcounter(1) = "EB_counter"
fieldcounter(2) = "UB_counter"
fieldcounter(3) = "TB_counter"
fieldcounter(4) = "Coach_counter"
For i = 1 To 4
counter = uidoc.FieldGetText(fieldcounter(i))
For j = 1 To counter
linkName = "SO_Link_" + Cstr(i) + "_" + Cstr(j)
feldName = "SO_Name_" + Cstr(i) + "_" + Cstr(j)
key = uidoc.FieldGetText(feldName)
Set rtitem = New NotesRichTextItem(doc,linkName)
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 uidoc.FieldClear(linkName)
Call rtitem.AppendDocLink(ldoc, "Link")
Call ReOpen(doc)
End If
Else
Call uidoc.FieldClear(linkName)
Call ReOpen(doc)
End If
Set rtitem = Nothing
Next j
Next i
End Sub
Weiß nicht mehr weiter... Danke für jede Hilfe.
Gruß
Björn
Edit: Ich glaube, es liegt an der Funktion ReOpen. Denn wenn ich die rausnehme, wird das rtitem problemlos neu gesetzt. Es wird nicht gemeckert. Jedoch wird auch kein Link erzeugt...
Danke Bernhard,
du hast völlig recht. Ich rufe nun ReOpen(doc) nach der Schleife auf und siehe da: ES GEHT!!! Nun klappt alles so, wie es sein soll.
Beste Grüße
Björn
Hier nochmals der FUNKTIONSFÄHIGE Code:
Sub Click(Source As Button)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument, ldoc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim key As Variant
Dim counter As Integer
Dim linkName As String, feldName As String, fieldcounter(1 To 4) As String
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Call uidoc.Save
Set doc = uidoc.Document
fieldcounter(1) = "EB_counter"
fieldcounter(2) = "UB_counter"
fieldcounter(3) = "TB_counter"
fieldcounter(4) = "Coach_counter"
For i = 1 To 4
counter = uidoc.FieldGetText(fieldcounter(i))
For j = 1 To counter
linkName = "SO_Link_" + Cstr(i) + "_" + Cstr(j)
feldName = "SO_Name_" + Cstr(i) + "_" + Cstr(j)
key = uidoc.FieldGetText(feldName)
Set rtitem = New NotesRichTextItem(doc,linkName)
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 uidoc.FieldClear(linkName)
Call rtitem.AppendDocLink(ldoc, "Link")
End If
Else
Call uidoc.FieldClear(linkName)
End If
Set rtitem = Nothing
Next j
Next i
Call ReOpen(doc)
End Sub
An der Funktion ReOpen habe ich nichts geändert.