1) Le Masque "TestDocLinkInView"
' c'est le masque qui contient le doclink
Etiquette------------Nom du champ---------------------Type / Properties
Titre___________[TestDocLinkInView_Titre]___________Texte / Editable
Auteur_________[TestDocLinkInView_Auteur]________Texte / Computed when composed
Date___________[TestDocLinkInView_Date]_________Date / Computed when composed
DocLink________[TestDocLinkInView_Link]___________RichText / Editable
Hidden Fileds (DocLink Properties)
Etiquette---------------Nom du champ---------------------Type / Properties
DisplayComment :_______[TD_DisplayComment]_____Texte / Editable
Replica ID: ____________[TD_ReplicaID] ___________Texte / Editable
View UNID: ____________[TD_ViewID] ____________ Texte / Editable
Doc UNID: _____________[TD_DocID] ____________ Texte / Editable
Server : ______________[TD_Server] _____________ Texte / Editable
Path: _______________[TD_Path] _______________ Texte / Editable
Global: _______________[TD_Global] _____________ Texte / Editable
Form Event :
- Code : Tout sélectionner
Sub Queryclose(Source As Notesuidocument, Continue As Variant)
Dim rti As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim doc As NotesDocument
Dim rtrange As NotesRichTextRange
Dim rtlink As NotesRichTextDocLink
Dim linkProperties As String
If source.EditMode = False Then
Continue = True
Exit Sub
End If
Set doc = source.Document
Set rti = doc.GetFirstItem("TestDocLinkInView_Link")
Set rtnav = rti.CreateNavigator
If rtnav.FindFirstElement(RTELEM_TYPE_DOCLINK) Then
Set rtrange = rti.CreateRange()
Set rtlink = rtnav.GetElement
Else
Continue = True
Exit Sub
End If
Dim linkDb As New NotesDatabase("", "")
Call linkDb.OpenByReplicaID(rtlink.ServerHint, rtlink.DbReplicaID)
Call source.FieldSetText("TD_DisplayComment", rtlink.DisplayComment)
Call source.FieldSetText("TD_ReplicaID", rtlink.DbReplicaID)
Call source.FieldSetText("TD_ViewID", rtlink.ViewUNID)
Call source.FieldSetText("TD_DocID", rtlink.DocUNID)
Call source.FieldSetText("TD_Server", rtlink.ServerHint)
Call source.FieldSetText("TD_Path", linkDb.FilePath)
Call source.Save()
continue =True
End Sub
(OPIONNEL)
'Ce bouton directement dans le masque, Affiche le path vers le Doclink du document puis ouvre le document en question.
- Code : Tout sélectionner
Sub Click(Source As Button)
Dim w As New NotesUIWorkspace
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim rti As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim rtlink As NotesRichTextDocLink
Set session = New NotesSession
Set db = session.CurrentDatabase
Set uiDoc = w.CurrentDocument
Set doc = uiDoc.Document
Set rti = doc.GetFirstItem("TestDocLinkInView_Link")
Set rtnav = rti.CreateNavigator
If rtnav.FindFirstElement(RTELEM_TYPE_DOCLINK) Then
Set rtrange = rti.CreateRange()
Set rtlink = rtnav.GetElement
End If
Dim linkDb As New NotesDatabase("", "")
If linkDb.OpenByReplicaID(rtlink.ServerHint, rtlink.DbReplicaID) Then
Messagebox linkDb.FilePath,, """" & linkDb.Title & """"
Else
Messagebox "No local replica",, "Cannot find database"
End If
If rtlink.DocUNID <> String$(32, "0") Then
On Error Goto InvalidUNID
Dim linkDoc As NotesDocument
Set linkDoc = linkDb.GetDocumentByUNID(rtlink.DocUNID)
Call w.EditDocument(False, linkDoc)
Exit Sub
End If
InvalidUNID:
Messagebox "Cannot locate document",, "No document"
Exit Sub
End Sub
2) la Vue "vDocLinkInView"
Colonne1 ________ [TestDocLinkInView_Titre]
Colonne2 _________26 (Display Value as Icon - Prog Use : Name = TD_Global)
View Event : InViewEdit
- Code : Tout sélectionner
Sub Inviewedit(Source As Notesuiview, Requesttype As Integer, Colprogname As Variant, Columnvalue As Variant, Continue As Variant)
On Error Goto ErrHandle
Dim w As New NotesUIWorkspace
Dim doc As NotesDocument
Dim caret As String
Dim global As String
Dim tmpServer As String
Dim tmpPath As String
Dim tmpReplica As String
Dim tmpNbCar As Integer
Dim tmpDocId As Variant
caret = Source.CaretNoteID
If caret = "0" Then Exit Sub
Set db = Source.View.Parent
Set doc = db.GetDocumentByID(caret)
If Colprogname(0) <> "" Then
global= doc.GetItemValue(Colprogname(0))(0)
tmpNbCar=Len(global)
tmpServer = Trim(Replace(Left(global,Instr(global,"#")),"#",""))
tmpPath= Trim(Right(global,(tmpNbCar-Instr(global,"|"))))
tmpDocID = Trim(Replace(Left(Right(global,(tmpNbCar-Instr(global,"@"))),Instr(Right(global,(tmpNbCar-Instr(global,"@"))),"|")),"|",""))
[color=green] 'Recuperation de l'Id de la base[/color]
Dim tmp As String
tmp= Mid(global, Instr(global,"#"), tmpNbCar-Instr(global,"#"))
tmpReplica = Trim(Replace(Replace(Left(tmp,Instr(tmp,"@")), "#",""), "@",""))
End If
Dim linkDb As New NotesDatabase("", "")
Call linkDb.OpenByReplicaID(tmpServer, tmpReplica)
Dim linkDoc As NotesDocument
Set linkDoc = linkDb.GetDocumentByUNID(tmpDocID)
Call w.EditDocument(False, linkDoc)
Exit Sub
ErrHandle:
Msgbox "Ce n'est pas un docLiknk !"
Exit Sub
End Sub
(OPTIONNEL)
Boutons D'action de la vue
|BTN Infos DocLink| ' Affiche dans un dialogBox les infos correspondant au DocLink
- Code : Tout sélectionner
Sub Click(Source As Button)
Dim session As NotesSession
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim rti As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim rtrange As NotesRichTextRange
Dim rtlink As NotesRichTextDocLink
Dim workspace As New NotesUIWorkspace
Dim uiView As NotesUIView
Dim col As NotesDocumentCollection
Set session = New NotesSession
Set db = session.CurrentDatabase
Set col = db.UnprocessedDocuments
If Col.Count <> 1 Then
Messagebox "Sélectionnez un seul document.", 48, ""
End
End If
Set Doc = col.GetFirstDocument
Set rti = doc.GetFirstItem("TestDocLinkInView_Link")
Set rtnav = rti.CreateNavigator
Set rtnav = rti.CreateNavigator
If rtnav.FindFirstElement(RTELEM_TYPE_DOCLINK) Then
Set rtrange = rti.CreateRange()
count% = 0
Do
Set rtlink = rtnav.GetElement
count% = count% + 1
msg$ = rtlink.DisplayComment & Chr(13) & Chr(13) & " - Replica ID = " & rtlink.DbReplicaID
If rtlink.ViewUNID <> String$(32, "0") Then
msg$ = msg$ & Chr(13) & " - View UNID = " & rtlink.ViewUNID
End If
If rtlink.DocUNID <> String$(32, "0") Then
msg$ = msg$ & Chr(13) & " - Doc UNID = " & rtlink.DocUNID
End If
Messagebox msg$ & Chr(13) & " - Serveur : " &rtlink.ServerHint ,, "Infos pour le DocLink N°"& count%
Loop While rtnav.FindNextElement( RTELEM_TYPE_DOCLINK)
End If
End Sub
|BTN Ouvrir le DocLink| ' Action qui ne sert strictement à rien dans la mesure ou elle fait exactement ce que fait un clic sur le link -lol- .... mais bon, dans un autre cas....
- Code : Tout sélectionner
Sub Click(Source As Button)
Dim w As New NotesUIWorkspace
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim rti As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim rtlink As NotesRichTextDocLink
Dim uiView As NotesUIView
Dim col As NotesDocumentCollection
Set session = New NotesSession
Set db = session.CurrentDatabase
Set col = db.UnprocessedDocuments
If Col.Count <> 1 Then
Messagebox "Sélectionnez un seul document.", 48, ""
End
End If
Set Doc = col.GetFirstDocument
Set rti = doc.GetFirstItem("TestDocLinkInView_Link")
Set rtnav = rti.CreateNavigator
If rtnav.FindFirstElement(RTELEM_TYPE_DOCLINK) Then
Set rtrange = rti.CreateRange()
Set rtlink = rtnav.GetElement
End If
Dim linkDb As New NotesDatabase("", "")
If linkDb.OpenByReplicaID(rtlink.ServerHint, rtlink.DbReplicaID) Then
Messagebox linkDb.FilePath,, """" & linkDb.Title & """"
Else
Messagebox "No local replica",, "Cannot find database"
End If
If rtlink.DocUNID <> String$(32, "0") Then
On Error Goto InvalidUNID
Dim linkDoc As NotesDocument
Set linkDoc = linkDb.GetDocumentByUNID(rtlink.DocUNID)
Call w.EditDocument(False, linkDoc)
Exit Sub
End If
InvalidUNID:
Messagebox "Cannot locate document",, "No document"
Exit Sub
End Sub[/size]
... reste à affiner u peu.... de manière à pouvoir ouvrir n'importe quel type de link...
