DominoArea.org [Archive]

Contexte : On utilise plusieurs documents profile type ( ex : frmApplicationProfile / frmServerProfile / frmWorkflowProfile ... ) utilisés dans différentes bases Notes.

Certaines base n'utilisent aucun document profile, d'autres un seul, quleques unes peuvent en contenir plusieurs, l'objectif étant de tester, pour une base donnée, l'exitence de ces différents documents Profile.

Problème rencontré :

L'utilisation de la méthode GetProfileDocument créé le doc s'il n'existe pas

On ne peut donc pas écrire quelque chose du genre

Code : Tout sélectionner

Set prodDocProfile = dbProd.GetProfileDocument("DocAppProfile")
 If Not prodDocProfile is nothing
    [...]   
 End if

Puisque cela ne renverra jamais Nothing !

(au moins) 2 Méthodes s'offrent alors....
la première, la moins couteuse (en ligne) consiste tout simplement à utiliser la propriété IsNewNote afin de tester si le document vient d'être créé

Code : Tout sélectionner

Dim xDb As NotesDatabase
Dim xSrv As String
Dim xPath As String
Dim docProfile As NotesDocument
   
xSrv = "Srv01/Srv/TST"
xPath ="Test\madb.nsf"
Set xDb = New NotesDatabase(xSrv, xPath)
   
Set docProfile = xDb.GetProfileDocument("frmApplicationProfile")
   
If Not docProfile.IsNewNote Then
    Msgbox "Doc frmApplicationProfile utilisé dans cette base" , "Test"
Else      
    Msgbox "Doc frmApplicationProfile absent" , "Test"
End If

La seconde impliquera de construire une collection des documents créés à partir de chaque masque des documents Profile... Il suffira ensuite de compter les documents en question.

Si le :Count de la collection renvoi 0, logiquement (sic) cette base ne possède pas ce type de docProfile.

Code : Tout sélectionner

Dim col As NotesDocumentCollection
Set Col = xDb.GetProfileDocCollection("frmApplicationProfile")

If col.count > 0 Then
    Msgbox "Doc frmApplicationProfile utilisé dans cette base" , "Test"
Else      
    Msgbox "Doc frmApplicationProfile absent" , "Test"
End If

voili

Allez, en prime voici une petite fonction bien pratique, offerte gracieusement par Michael à utiliser sans modération.

Code : Tout sélectionner

Function DocProfilGet(wProfilName As String, wUniqueKey As String) As NotesDocument

 Dim Session As NotesSession
   Dim DB As NotesDatabase
   Dim Collection As notesDocumentCollection
   On Error Goto ErreurHandle

   Set DocProfilGet = Nothing         

   Set Session = New NotesSession
   Set DB = Session.CurrentDatabase
   Set Collection = DB.GetProfileDocCollection(wProfilName)

   If Collection Is Nothing Then
      Exit Function
   End If
   
  Select Case Collection.Count
   Case 0
      'on ne fait rien
   Case 1
      Set DocProfilGet = Collection.GetFirstDocument
   Case Else
      Set DocProfilGet = Collection.GetFirstDocument
      While Not DocProfilGet Is Nothing
         If DocProfilGet.Key = wUniqueKey Then
            Set Collection = Nothing
            Exit Function
         End If         
 Set DocProfilGet = Collection.GetNextDocument(DocProfilGet)
      Wend
End Select
    Set Collection = Nothing

   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 DocProfilGet = Nothing
   Exit Function
End Function

et un
db.GetProfileDocCollection ?

Ahamay a écrit:
Dim col As NotesDocumentCollection
Set Col = xDb.GetProfileDocCollection("frmApplicationProfile")

If col.count > 0 Then
    Msgbox "Doc frmApplicationProfile utilisé dans cette base" , "Test"
Else
    Msgbox "Doc frmApplicationProfile absent" , "Test"
End If

Pfff...... heureusement que c'est le week end hein

Et encore ... pas fini cette semaine! J'espère que j'aurai les yeux mieux ouvert sur la route.

Bin Bon Week et ...
Profite bien alors