jupp. Läuft gut.
Hier fertiger Code zum rauskopieren.
Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc = ws.currentdocument
Dim s As New NotesSession
Dim db As NotesDatabase
Dim col As NotesDocumentCollection
Dim doc As NotesDocument
Dim backdoc As NotesDocument
Dim rtitem As NotesRichTextItem
Set db = s.CurrentDatabase
Set backdoc = uidoc.document
Set col = ws.PickListCollection(1,True,"SPSRV1","Parchiv","Presentations","Info","select a document")
If col.Count = 0 Then
Msgbox ("Sie haben kein Dokument ausgewählt")
Exit Sub
End If
Set doc = col.getfirstdocument
Set rtitem = New NotesRichTextItem( backdoc, "Presentationsdoclink" )
Call rtitem.AppendDocLink( doc, db.title)
Call uidoc.Save
Call uidoc.Close
Call backdoc.Save(True, True)
Set uidoc = ws.EditDocument( editMode , backdoc)
End Sub
Danke...