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
