DatabaseGetDocumentByUnid

[abertisch]

Petit code bien utile pour remplacer la fonction "GetDocumentByUNID".

Code : Tout sélectionner

Function DatabaseGetDocumentByUnid (db As NotesDatabase, unid$) As NotesDocument
   
   On Error 4091 Resume Next
   
   Set DatabaseGetDocumentByUnid = Nothing
   
   Set DatabaseGetDocumentByUnid =    db.GetDocumentByUnid(unid$)
   
   If Err = 4091 And (DatabaseGetDocumentByUnid Is Nothing) Then
      Err = 0
      Set DatabaseGetDocumentByUnid = Nothing
      Exit Function
   End If
   
   If DatabaseGetDocumentByUnid Is Nothing Then
      Set DatabaseGetDocumentByUnid = Nothing
      Exit Function
   End If
   
   If DatabaseGetDocumentByUnid.Size = 0 Or DatabaseGetDocumentByUnid.UniversalID = "" _
   Or DatabaseGetDocumentByUnid.IsDeleted Then
      Set DatabaseGetDocumentByUnid = Nothing
      Exit Function
   End If
   
End Function

[Michael DELIQUE]

Ma Version

Code : Tout sélectionner

Public Function DocSearchByUNID(Byval wID As String,wDB As NotesDatabase, Byval wChamp As String,  Byval wForm As String) As NotesDocument
   
   'fonction de recherche d'un document grace a son universalid ou son notes id
   
      'Déclaration de variables
   Dim Selection As String
   Dim Collection As NotesDocumentCollection
   Dim DB2 As NotesDatabase
   
   On Error Goto ErreurHandle
   
   If Trim(wID) = "" Then
      Set  DocSearchByUNID = Nothing
   End If
   
   'connexion à l abase
   If wDB Is Nothing Then
      Set Session = New NotesSession
      Set DB2 = Session.Currentdatabase
   Else
      Set DB2 = wDB
   End If
   
   On Error Resume Next
   
   'recherche du document
   If Len(Trim(wID))<10 Then
   ' sur Universal Id
      Set  DocSearchByUNID = Db2.GetDocumentbyId(Trim(wID))
   Else
   ' sur l'id   
      Set  DocSearchByUNID = Db2.GetDocumentbyUnid(Trim(wID))
   End If
   
   On Error Goto ErreurHandle
   
   'controle si un document est résupéré, si le document exist controle les données sinon passe à l'autre pahse de recherche
   If Not  DocSearchByUNID Is Nothing Then
      If  DocSearchByUNID.Size = 0 Then
         Set  DocSearchByUNID = Nothing
      Elseif Trim( DocSearchByUNID.UniversalID) = "" Then
         Set  DocSearchByUNID = Nothing
      Elseif  DocSearchByUNID.IsDeleted = True Then
         Set  DocSearchByUNID = Nothing
      End If
   End If    
   
   If Not  DocSearchByUNID Is Nothing Then
      Set DB2 = Nothing
      Exit Function
   End If   
   
   If Trim(wChamp) = "" Then
      Set  DocSearchByUNID = Nothing
      Exit Function
   Elseif Trim(wForm) = "" Then
      Set  DocSearchByUNID = Nothing
      Exit Function
   End If
   
   Selection = {@uppercase(@trim(Form))="}+Ucase(Trim(wForm))+{" & }+Trim(wChamp)+{ = "}+Trim(wID)+{"}
   
   Set Collection = Nothing
   Set Collection = Db2.search(Selection,Nothing,0)
   
   If Collection Is Nothing Then
      Set  DocSearchByUNID = Nothing
      Exit Function
   Elseif Collection.Count = 0 Then
      Set  DocSearchByUNID = Nothing
      Exit Function
   End If
   
   Set  DocSearchByUNID = Collection.GetFirstDocument
   
   Set Collection = Nothing   
   Set DB2 = Nothing

 If Not  DocSearchByUNID Is Nothing Then
      If  DocSearchByUNID.Size = 0 Then
         Set  DocSearchByUNID = Nothing
      Elseif Trim( DocSearchByUNID.UniversalID) = "" Then
         Set  DocSearchByUNID = Nothing
      Elseif  DocSearchByUNID.IsDeleted = True Then
         Set  DocSearchByUNID = Nothing
      End If
   End If 
   
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Set  DocSearchByUNID = Nothing
   Exit Function   
End Function