DominoArea.org [Archive]

Je suis parvenu à mes fins en tatonnant... je laisse toutes les étapes qui m'ont permis d'y arriver. Normalement avec les différentes fonctions utilisées on doit pouvoir répondre à peu près à tous les besoins concernant les DocLink. Par ailleurs, pour que ce soit plus aisé à comprendre, je n'ai pas chercher à optimiser le code... les HiddenFields du masque ne sont pas obligatoire par exemple, 1 seul suffirait. Mais bon... c'est un TIP


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...

Un Btn (à ajouter dans la vue) qui ouvre n'importe quel type de link

Code : Tout sélectionner

Sub Click(Source As Button)
   Dim w As New NotesUIWorkspace
   Dim session As NotesSession
   Dim db As NotesDatabase
   Dim col As NotesDocumentCollection
   Dim doc As NotesDocument
   Dim rti As NotesRichTextItem
   Dim rtnav As NotesRichTextNavigator
   Dim rtrange As NotesRichTextRange
   Dim rtlink As  NotesRichTextDocLink
   Dim repType As String
   Dim linkDb As New NotesDatabase("", "")
   Dim tmpServer As String
   Dim tmpUrl As String
   
   On Error Goto ErrHandle
   
   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
      tmpServer=Replace(Replace(Left(rtlink.ServerHint, Instr(rtlink.ServerHint,"/")), "/", ""), "CN=", "")
      
      If  rtlink.ViewUNID = String$(32, "0") And  rtlink.DocUNID = String$(32, "0") Then
      repType = "DbLink"         
      tmpUrl = "Notes://"+tmpServer+"/"+rtlink.DbReplicaID
      Elseif rtlink.DocUNID = String$(32, "0") Then
      repType = "ViewLink"
      tmpUrl = "Notes://"+tmpServer+"/"+rtlink.DbReplicaID+"/"+rtlink.ViewUNID
      Else
       repType = "DocLink"
      tmpUrl =  "Notes://"+tmpServer+"/"+rtlink.DbReplicaID+"/"+rtlink.ViewUNID+"/"+rtlink.DocUNID   
      End If

      Messagebox repType      
      w.UrlOpen tmpUrl
   End If
   Exit Sub
   
ErrHandle:
   Msgbox "Err : "+Str$(Error)
   Exit Sub
End Sub


* Me suis pas amusé à gérer les erreurs (pour l'instant)... mais bon, un test ou deux et ça devrait le faire

Et pour finir ......
InViewEdit de la vue (Annule et remplace le précèdent)

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 String
   Dim tmp As String
   
   
   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)

        %REM
        Rappel : Format du champ "Global"
        NomComplet du Serveur # ReplicaID @ ViewUNID | DocUNID
        %END REM

      tmpNbCar=Len(global)
      
      tmpSrv = Trim(Replace(Left(global,Instr(global,"#")),"#",""))       
      tmpServer=Replace(Replace(Left(tmpSrv, Instr(tmpSrv,"/")), "/", ""), "CN=", "")      ' Recuperation du Server
      
      tmp= Mid(global, Instr(global,"#"), tmpNbCar-Instr(global,"#"))      
      tmpReplica = Trim(Replace(Replace(Left(tmp,Instr(tmp,"@")), "#",""), "@",""))      ' Recuperation du ReplicaID
      
      tmpView= Trim(Right(global,(tmpNbCar-Instr(global,"|"))))                            ' Recuperation du ViewUNID

      tmpDocID = Trim(Replace(Left(Right(global,(tmpNbCar-Instr(global,"@"))),_
      Instr(Right(global,(tmpNbCar-Instr(global,"@"))),"|")),"|",""))                     ' Recuperation du DocUNID
      
      
      If tmpView = String$(32, "0") And tmpDocId =String$(32, "0") Then
         repType = "DbLink"            
         tmpUrl = "Notes://"+tmpServer+"/"+tmpReplica
      Elseif  tmpDocId =String$(32, "0") Then
         repType = "ViewLink"
         tmpUrl = "Notes://"+tmpServer+"/"+tmpReplica+"/"+tmpView   
      Else
         repType = "DocLink"
         tmpUrl =  "Notes://"+tmpServer+"/"+tmpReplica+"/"+tmpView+"/"+tmpDocId
      End If
      
      Messagebox repType      
      w.UrlOpen tmpUrl
      
   End If   
   Exit Sub
   
ErrHandle:
   Msgbox "Err : " + Str$(Error)
   Exit Sub
   
End Sub

un upload d'une base de démo serait apprécié je crois
si tu as le temps d'en concevoir une merci bcp

J'ai deja une base de demo de même que j'ai ce tip avec des captures d'ecran et tout.... en fait j'ai une zoli knowledge base perso avec tout plein d'exemples des tips et autres soluce pondues ou trouvées ici.....

Le big soucis c'est que de la ou je bosse je n'ai aucune possibilité de sortir quoique ce soit. j'peux meme pas me la mailler à moi même, c'est dire .....

je vais essayer de faire ça de chez moi...