DominoArea.org [Archive]

Merci à Goonies pour ce Lien => http://www.nsftools.com/tips/SelectedDocsList.lss qui m'a permis de faire la fonction.

ATTENTION ELLE NE MARCHERA QU'EN FRONTALE

Code : Tout sélectionner

Public Function UIEmbededViewSelectDoc_API(wvwVue As NotesView, wNameView As String) As Variant
   'NE FONCTIONNE QU'EN FRONTALE
   
   ' Renvois la liste des UNIVERSALID des documents sélèctionnés dans une vue intégré.
   'il faut passer en paramettre ou la vue ou le nom de la vue
   
   
   
%REM
'variableAPI pour la fonction UIEmbededViewSelectDoc_API
these are Windows specific calls -- please adjust as necessary for other operating system platforms
   Declare Function NIFCloseCollection Lib "nnotes.dll" (Byval hCollection As Long) As Integer
   Declare Function IDScan Lib "nnotes" ( Byval hTable As Long, Byval tFirstBool As Integer, retID As Long) As Integer
   Declare Function IDEntries Lib "nnotes" ( Byval hTable As Long ) As Long
   Declare Function NIFOpenCollection Lib "nnotes.dll" (Byval hDB As Long, Byval hDB As Long, Byval ViewNoteID As Long, Byval openFlags As Integer, Byval hUnreadList As Long, hCollection As Long, Byval hNullVal As Long, hViewUnid As Long, hCollapsedList As Long, hSelectedList As Long ) As Integer
   Declare Function NSFDbOpen Lib "nnotes.dll" (Byval dbName As String, rethDb As Long) As Integer
   Declare Function NSFDbClose Lib "nnotes.dll" (Byval hDb As Long) As Integer
   Declare Function OSPathNetConstruct Lib "nnotes.dll" (Byval portName As Integer, Byval serverName As String, Byval fileName As String, Byval pathName As String) As Integer
%END REM
   'Déclaration Variable
   Dim nbHandleDB As Long
   Dim nbviewNoteID As Long
   Dim nbHandleCollection As Long
   Dim nbHandleIDTable As Long
   Dim pathName As String*256
   Dim nbNoteID As Long
   Dim noteIDString As String
   Dim nbFlag As Integer
   Dim nbResult As Integer
   Dim i As Long
   Dim lstDocID List As String
   Dim vwEmbeded As NotesView
   Dim Doc As NotesDocument
   
   On Error Goto ErreurHandle
   
   lstDocID(0) = 0
   UIEmbededViewSelectDoc_API = lstDocID
   
   If DB Is Nothing Or Session Is Nothing Then
      Set Session = New NotesSession
      Set DB = Session.CUrrentdatabase
   End If
   
   'test des paramètres
   If wvwVue Is Nothing And Trim(wNameView) = "" Then
      Error 9999,"wvwVue and wNameView are Nothing"
      Exit Function
   End If
   
   'initialise la vue
   If Not wvwVue Is Nothing Then
      Set vwEmbeded = wvwVue
   Elseif Trim(wNameView) <> "" Then
      Set vwEmbeded = db.GetView(Trim(wNameView) )
   End If
   
   If vwEmbeded Is Nothing Then
      Error 9999, "vwEmbeded is Nothing"
      Exit Function
   End If
   
   'Génération d'un identifiant réseau
   Call OSPathNetConstruct(0, Db.Server, Db.FilePath, pathName)
   nbResult = NSFDbOpen(pathName, nbHandleDB)
   If nbResult <> 0 Then
      Set vwEmbeded = Nothing
      Error 9999," Cannot open database " + Db.FilePath + " on server " + Db.Server + ". Error was " + Cstr(nbResult) + " : " + GetAPIError( nbResult )
      Exit Function
   End If
   
   'Génration de l'ID de la vue au format héxadécimale
   Set Doc = db.GetDocumentByUNID(vwEmbeded.UniversalID)
   If Doc Is Nothing Then
      Error 9999,"Doc is Nothing"
   End If
   On Error Resume Next
   nbviewNoteID = Val("&H" & Trim(doc.NoteID) & "&")
   On Error Goto ErreurHandle
   
   'Récupération de la table des Document/ligne de la vue sélectionnés
   nbResult = NIFOpenCollection(nbHandleDB, nbHandleDB, nbviewNoteID, 0, 0, nbHandleCollection, 0, 0, 0, nbHandleIDTable)
   If nbResult <> 0 Then
      Set vwEmbeded = Nothing
      Call NSFDbClose(nbHandleDB)
      Error 9999,"Cannot open collection for " +vwEmbeded.Name + " on " +   Db.FilePath +" on server " +Db.Server +". Error was " & Cstr(nbResult) & ": " & GetAPIError( nbResult )
      Exit Function
   End If
   
   ' controle si au moins 1 document/une ligne de la vue a été sélèctionné
   i = IDEntries(nbHandleIDTable)
   If (i = 0) Then
      If (nbHandleCollection > 0) Then
         Set vwEmbeded = Nothing
         Call NIFCloseCollection(nbHandleCollection)
         Call NSFDbClose(nbHandleDB)
         Exit Function
      End If
   End If
   i = 0
   
   nbFlag = True
   i=0
   Do While IDScan(nbHandleIDTable, nbFlag, nbNoteID) > 0
      nbFlag = False
      noteIDString = Hex$(nbNoteID)
      noteIDString = String(8 - Len(noteIDString), "0") & noteIDString
      
      If (Left(noteIDString, 1) = "8") Then
         'la ligne sélèctionné est une atégorie et non un document
      Else
         'si il ya un Id Notes c'est bien un document
         If (Len(noteIDString) > 0) Then
            'Connexion au document et récupération de l'universalID
            On Error Resume Next
            Set Doc = DB.GetDocumentByID(noteIDString)
            On Error Goto ErreurHandle
            If Not doc Is Nothing Then
               i=i+1
               lstDocID(i) = Trim(Cstr(Doc.UniversalID))
               Set Doc = Nothing
            End If   
         End If
      End If
      noteIDString = ""
   Loop
   
   If i>0 Then
      'renseigne le nomre de doc sélectionné su la premier eligne du tableau
      lstDocID(0) =Cstr(i)
      'renvois la liste trouvé
      UIEmbededViewSelectDoc_API = lstDocID
   End If
   
   i=0
   Set vwEmbeded = Nothing
   Erase lstDocID
   If (nbHandleCollection > 0) Then
      Call NIFCloseCollection(nbHandleCollection)
   End If
   Call NSFDbClose(nbHandleDB)
   
   Exit Function
ErreurHandle:
   Msgbox "("+Structure_Log+" : "+Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Erase lstDocID   
   lstDocID(0) = 0
   UIEmbededViewSelectDoc_API = lstDocID
   Erase lstDocID
   Exit Function
End Function

Code : Tout sélectionner

Function GetAPIError (nbErrorCode As Integer) As String
%REM
'variableAPI pour la fonction DeletePrivateView_API
   Declare Function OSLoadString Lib "nnotes.dll" (Byval hModule As Long, Byval stringCode As Integer, Byval retBuffer As String, Byval bufferLength As Integer) As Integer
%END REM
   
   'Déclaration Variable
   Dim errorString As String*256
   Dim returnErrorString As String
   Dim nbResultStringLength As Long
   Dim nbErrorCodeTranslated As Integer
   
   Const ERR_MASK = &H3fff
   Const PKG_MASK = &H3f00
   Const ERRNUM_MASK = &H00ff
   
   On Error Goto ErreurHandle
   
   GetAPIError = ""
   
       '** mask off the top 2 bits of the nbErrorCode that was returned; this is
       '** what the ERR macro in the API does
   nbErrorCodeTranslated = (nbErrorCode And ERR_MASK)
   
       '** get the error code translation using the OSLoadString API function
   nbResultStringLength = OSLoadString(0, nbErrorCodeTranslated, errorString, Len(errorString) - 1)
   
       '** strip off the null-termination on the string before you return it
   If (Instr(errorString, Chr(0)) > 0) Then
      returnErrorString = Left$(errorString, Instr(errorString, Chr(0)) - 1)
   Else
      returnErrorString = errorString
   End If
   
   GetAPIError = returnErrorString
   Exit Function
ErreurHandle:
   Msgbox "("+Structure_Log+" : "+Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   
   GetAPIError = ""
   Exit Function
End Function

la fonction ne renverra rien si l'option "Show Single Category" est activé ce qui en limite beaucoup (voir completement) l'utilité.