Effacer les documents Profils

[Michael DELIQUE]

Fonctio développé pour la V5 en V6 il ya de nouveaux objets (NotesNotesCollection) qui sont plus pratique à utiliser


[syntax="ls"]Sub DeleteProfileDoc(wNomForm As String,wUser As String,wnbConfirme As Integer)
'efface les documents profiles de la base

'wNomForm : si vide efface tous les document profils, sinon efface les document dont le form est passer en paramêtre
'wUser : si wuser vide alors efface tout les utilsateur, sinon eface l'utilisateur paaser en paramêtre
'wConfirme : pour avoir ou pas un message de confirmation

'Déclaration des Variables
Dim Session As NotesSession
Dim DB As NotesDatabase
Dim Doc As NotesDocument
Dim Collection As NotesDocumentCollection
Dim nbValue As Integer
Dim i As Long

On Error Goto ErreurDeleteProfileDoc

Set Session = New NotesSession
Set DB = Session.CUrrentdatabase

If Trim(wNomForm)= "" Then
nbValue = False
'genere les collections de document et test si il ya des document à effacer
Set Collection = Nothing
Set Collection = db.GetProfileDocCollection("")
If Not Collection Is Nothing Then
If Collection.count > 0 Then
nbValue = True
End If
End If

Set Collection = Nothing

If nbValue = False Then
Set Collection = db.GetProfileDocCollection()
If Not Collection Is Nothing Then
If Collection.count > 0 Then
nbValue = True
End If
End If
End If

If nbValue = True Then
If wnbConfirme = True Then
i=7
i = Msgbox ("Etes-vous certain de vouloir effacer tous les documents profils ?",4+32+256,"CONFIRMATION DE SUPPRESSION !")
If i = 7 Then
Exit Sub
End If
End If

i = 0
Set Collection = Nothing
Set Collection = db.GetProfileDocCollection("")
If Not Collection Is Nothing Then
If Collection.count > 0 Then
i = Collection.count
Call Collection.removeall(True)
End If
End If

Set Collection = Nothing
Set Collection = db.GetProfileDocCollection()
If Not Collection Is Nothing Then
If Collection.count > 0 Then
i = i+Collection.count
Call Collection.removeall(True)
End If
End If
If i = 1 Then
Msgbox "Un document profile effacé"
Else
Msgbox Cstr(i)+" documents profiles effacés"
End If
Else
Msgbox "Aucun document à supprimer.",64,"OPERATION IMPOSSIBLE"
End If
Else
If Trim(wUser) = "" Then
Set Collection = Nothing
Set Collection = db.GetProfileDocCollection(wNomForm)
If Not Collection Is Nothing Then
If Collection.count > 0 Then
If wnbConfirme = True Then
i=7
i = Msgbox ("Etes-vous certain de vouloir effacer tous les documents profils nommés : "+wNomForm,4+32+256,"CONFIRMATION DE SUPPRESSION !")
If i = 7 Then
Exit Sub
End If
End If
i = 0
i = Collection.count
Call Collection.removeall(True)
If i = 1 Then
Msgbox "Un document profile effacé"
Else
Msgbox Cstr(i)+" documents profiles effacés"
End If
Else
Msgbox "Aucun document à supprimer."+Chr(10)+wNomForm,64,"OPERATION IMPOSSIBLE"
End If
Else
Msgbox "Aucun document à supprimer."+Chr(10)+wNomForm,64,"OPERATION IMPOSSIBLE"
End If
Else
Set Doc = DB.getProfileDocument(wNomForm,wUser)
If Doc Is Nothing Then
Msgbox "Aucun document à supprimer."+Chr(10)+wNomForm+Chr(10)+wUser,64,"OPERATION IMPOSSIBLE"
Else
If wnbConfirme = True Then
i=7
i = Msgbox ("Etes-vous certain de vouloir effacer tous le documents profils nommé : "+wNomForm+" ayant comme clé : "+wUser,4+32+256,"CONFIRMATION DE SUPPRESSION !")
If i = 7 Then
Exit Sub
End If
End If
Call Doc.Remove(True)
Msgbox "Le document profile est d'effacé"
End If
End If
End If

i = 0
Set Collection = Nothing

Exit Sub
ErreurDeleteProfileDoc:
Msgbox "(DeleteProfileDoc) Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Sub
End Sub[/syntax]