Générer l'URL Notes d'un Document

[Michael DELIQUE]

Code : Tout sélectionner

Public Function NotesURL_LS(wDoc As NotesDocument,wDB As NotesDatabase) As String
   
   'Déclaration Variable
   Dim DBURL As NotesDatabase
   Dim nmServer As NotesName
   Dim Server As String
   
   On Error Goto ErreurHandle
   NotesURL_LS = ""
   
   If wDoc Is Nothing Then
      Error 9999,"wDoc is nothing"
      Exit Function
   End If
   
   NotesURL_LS = Cstr(wDoc.NotesURL)
   
   If Trim(NotesURL_LS) <> "" Then
      Exit Function
   End If
   
   If wDB Is Nothing Then
      Server = ""
   Else
      If DBExists_LS(wDB) = False Then
         Error 9999,"wDB is nothing or not ready"
         Exit Function
      End If
      Set nmServer = New NotesName(wDB.Server)
      Server = nmServer.Common
      Set nmServer = Nothing
   End If
   
   NotesURL_LS = {Notes://}+Server+{/}+wdb.ReplicaID+{/0/}+wDoc.UniversalID
   
   Exit Function
ErreurHandle:
   Msgbox "("Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   NotesURL_LS = ""
   Exit Function
End Function

Code : Tout sélectionner

Public Function DBExists_LS(wdb As NotesDatabase) As Integer
   'teste si une base de donnée est accéssible
'   renvoi true si elle est accéssible
' renvoi false si elle n'est pas accessible
   
   On Error Goto ErreurDBExists_LS
   
   'teste si la variable est renseigné
   If wDB Is Nothing Then
      DBExists_LS = False
      Exit Function
   Else
      'teste si la base est ouverte
      If wDB.IsOpen = True Then
      'teste si la base existe réelement il faut que la date de crétation existe ainsi que l'id de réplique
         If Trim(Cstr(wDB.Created)) = "" Or Trim(Cstr(wDB.ReplicaID)) = "" Then
            DBExists_LS = False
            Exit Function
         End If
      Else
         DBExists_LS = False
         Exit Function
      End If
   End If
   
   DBExists_LS = True
   
   Exit Function
ErreurDBExists_LS:
   Msgbox "("Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   DBExists_LS = False
   Exit Function
End Function