Alors voilà :
[Déclarations]
[syntax="LotusScript"]
Dim session As NotesSession
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim collection As NotesDocumentCollection
Dim docfils As NotesDocument
Dim docgrandpere As NotesDocument
Dim docpere As NotesDocument
Dim fTitreMQ As String
' Paramétrage
Const PRM_ERREUR = "[ERREUR PARAMETRAGE]"
Const PRM_NEXISTE = "Il n'existe pas de document de paramétrage : contactez l'administrateur de la base."
[/syntax]
[Initialize]
[syntax="LotusScript"]
Sub Initialize
On Error Goto erreur
Set session = New notessession
Set db = session.CurrentDatabase
'--- Récupérer le document de profil
Set pdoc = db.GetProfileDocument("Profil")
If Not (pdoc Is Nothing ) Then
fTitreMQ = pdoc.NomManuel(0)
Else
Msgbox PRM_NEXISTE, MB_OK + 16, PRM_ERREUR
Exit Sub
End If
Set collection = db.UnprocessedDocuments
If (collection.count = 0) Then Exit Sub
Set docfils = collection.GetFirstDocument
Print "Début : "+Cstr(Now)
i = 0
' docfils = document approuvé masque [DocMaj] ou [ManuelMaj]
Do While Not docfils Is Nothing
i = i+1
Select Case docfils.WF_Etat(0)
Case "4"
'cas des documents validés en attente d'être activés
Etat4Traiter
End Select
session.UpdateProcessedDoc docfils
Set docfils = collection.GetNextDocument(docfils)
Loop
Print "Nombre de documents traités : "+Cstr(i )
Print "Fin : "+Cstr(Now)
Exit Sub
erreur :
Print "Erreur !"
Print "Document n° : "+Cstr(i)
Print "Error" & Str(Err) & ": " & Error$
Resume Next
End Sub
[/syntax]
[Etat4Traiter]
[syntax="LotusScript"]
Sub Etat4Traiter
Dim ws As New NotesUIWorkspace
'en cas d'erreur on continue le processus
On Error Goto erreur
Select Case docfils.Form(0)
Case "ManuelMaj"
' docpere = document parent de docfils = masque [Manuel]
' Archivage du document père, transformation du fils en [Manuel]
Set docpere = db.GetDocumentByUNID(docfils.IDParent(0))
docpere.WF_Etat = "6"
docpere.WF_Date = Now
docpere.LIBELLEETAT = "Archivé"
docpere.DEMANDEENCOURS = ""
Call docpere.Save (True,False)
docfils.Form="Manuel"
docfils.COMMENTAIREDIFFUSION=""
docfils.DEMANDEENCOURS = ""
docfils.LIBELLEETAT = "Actif"
docfils.WF_Etat="5"
docfils.WF_Date = Now
docfils.WF_Auteurs =""
' Mettre à jour les champs concernant les modifications
ModificationsMaj
Call docfils.Save (True, False)
' Màj hiérarchie => Les fils du document archivé sont maintenant ceux du document actif
HierarchieMaj
Set uidoc = ws.EditDocument( True, docfils )
Call uidoc.Reload
Call uidoc.Save
Call uidoc.Close
' Oter les commentaires
CommentairesOter docpere
Case "DocMaj"
' docpere = document parent de docfils = masque [Document] (celui à partir duquel on a créé la demande màj)
' docgrandpere = document parent de docpere
' Archivage de docpere, transformation de docfils en [Document] avec un statut "Actif"
Set docpere = db.GetDocumentByUNID(docfils.IDParent(0))
Set docgrandpere = db.GetDocumentByUNID(docpere.IDParent(0))
docpere.WF_Etat = "6"
docpere.WF_Date = Now
docpere.LIBELLEETAT = "Archivé"
docpere.DEMANDEENCOURS = ""
Call docpere.Save(True,False)
docfils.Form="Document"
docfils.IDParent = docgrandpere.IDGeneral(0) 'Le parent du docfils est celui de docpere qui va être archivé
docfils.MakeResponse docgrandpere
docfils.INFOPERE = "Codification : " + docgrandpere.TRITYPEDOCUMENT(0) + docgrandpere.RADICAL(0) + " Titre : " + docgrandpere.TITRE1(0)
' Mettre à jour les champs concernant les modifications
ModificationsMaj
docfils.COMMENTAIREDIFFUSION=""
docfils.DEMANDEENCOURS = ""
docfils.LIBELLEETAT = "Actif"
docfils.Wf_Date = Now
docfils.WF_Etat = "5"
Call docfils.Save (True,False)
' Màj hiérarchie => Les fils du document archivé sont maintenant ceux du document actif
HierarchieMaj
' Oter les commentaires
CommentairesOter docpere
Case "DocDel"
' docpere = document parent de docfils = masque [Document] (celui à partir duquel on a créé la demande Suppr)
' docgrandpere = document parent de docpere
' Archivage de docpere, transformation de docfils en archive lui aussi en lui donnant le même pere que docpere
Set docpere = db.GetDocumentByUNID(docfils.IDParent(0))
Set docgrandpere = db.GetDocumentByUNID(docpere.IDParent(0))
docpere.WF_Etat = "6"
docpere.WF_Date = Now
docpere.LIBELLEETAT = "Archivé"
docpere.DEMANDEENCOURS = ""
Call docpere.Save (True, False)
docfils.COMMENTAIREDIFFUSION=""
docfils.INFOPERE = "Codification : " + docgrandpere.TRITYPEDOCUMENT(0) + docgrandpere.RADICAL(0) + " Titre : " + docgrandpere.TITRE1(0)
docfils.DEMANDEENCOURS = ""
docfils.LIBELLEETAT = "Archivé"
docfils.WF_Etat = "6"
docfils.WF_Date = Now
docfils.WF_Auteurs = ""
docfils.WF_Createur = docfils.AUTEUR
docfils.IDParent = docgrandpere.IDGeneral 'nouveau père
docgrandpere.MakeResponse docfils
Call docfils.Save (True,False)
' Oter les commentaires
CommentairesOter docpere
Case "Manuel"
docfils.LIBELLEETAT = "Actif"
docfils.WF_Etat = "5"
docfils.WF_Date = Now
docfils.WF_Auteurs =""
docfils.WF_Createur = docfils.AUTEUR
docfils.COMMENTAIREDIFFUSION=""
Call docfils.Save (True, False)
Case "Document"
docfils.LIBELLEETAT = "Actif"
docfils.COMMENTAIREDIFFUSION=""
docfils.WF_Etat = "5"
docfils.WF_Date = Now
docfils.WF_Auteurs =""
docfils.WF_Createur = docfils.AUTEUR
Call docfils.Save (True,False)
End Select
Exit Sub
erreur :
Print "Agent ADA - Erreur Etat4Traiter :" & Str(Err) & ": " & Error$
Resume Next
End Sub
[/syntax]
[HierarchieMaj]
[syntax="LotusScript"]
Sub HierarchieMaj
Dim doctmp As NotesDocument
Dim colrep As Variant
'en cas d'erreur on continue le processus
On Error Goto ErreurAgent
Set colrep = docpere.Responses
If Not colrep Is Nothing Then
Set doctmp = colrep.GetFirstDocument
'on change les filiations des documents fils de l'ancienne version vers la nouvelle version
Do While Not doctmp Is Nothing
If (doctmp.UniversalID <> docfils.UniversalID) And Ucase(doctmp.Form(0)) <> "Commentaire" Then
doctmp.IDParent = docfils.UniversalID
doctmp.MakeResponse docfils
Call doctmp.Save(True, True)
End If
Set doctmp = colrep.GetNextDocument(doctmp)
Loop
End If
Exit Sub
ErreurAgent :
Print "Agent ADA - HierarchieMAJ" & Str(Err) & ": " & Error$
Resume Next
End Sub
[/syntax]
[ModificationsMaj]
[syntax="LotusScript"]
Sub ModificationsMaj
Dim rtitem As Variant
Dim sEntete As String
Dim sBody As String
Dim itemCourant As NotesItem
Dim itemSuivant As NotesItem
Dim iTotal As Integer
'en cas d'erreur on continue le processus
On Error Goto ErreurAgent
iTotal = Val(docfils.mCount(0)) + 1
docfils.mCount = Cstr(iTotal)
' PARTIE HISTORIQUE
Dim rstyle As NotesRichTextStyle ' bleu, gras, taille 10 pour le titre
Set rstyle = session.CreateRichTextStyle
rstyle.FontSize = 9
rstyle.Bold = True
rstyle.NotesColor = 10
sEntete = "INDICE : " + Cstr(docfils.emIndice(0)) + ESP_5 + "Le : " + Cstr(docfils.emDate(0)) + ESP_5 + "Par : " + Cstr(docfils.emWho(0))
sBody = docfils.emTexte(0)
Set rtitem = docfils.GetFirstItem( "hmTexte" )
Call rtitem.AddNewLine( 1 )
Call rtitem.AppendStyle(rstyle)
Call rtitem.AppendText( sEntete )
rstyle.FontSize = 8
rstyle.Bold = False
rstyle.NotesColor = 0
Call rtitem.AppendStyle(rstyle)
Call rtitem.AddNewLine( 1 )
Call rtitem.AppendText( sBody )
Call rtitem.AddNewLine( 2 )
'PARTIE TABLEAU
If iTotal < 7 Then
' On peut ajouter les historiques dans le tableau à imprimer
iNombre = iTotal
Else
' On doit décaler les lignes du tableau à imprimer vers le haut
For cpt = 1 To 5
nomCourant = "mIndice_" + Cstr(cpt)
nomSuivant = "mIndice_" + Cstr(cpt + 1)
Set itemCourant = docfils.GetFirstItem(nomCourant)
Set itemSuivant = docfils.GetFirstItem(nomSuivant)
itemCourant.Values = itemSuivant.Values
nomCourant = "mTexte_" + Cstr(cpt)
nomSuivant = "mTexte_" + Cstr(cpt + 1)
Set itemCourant = docfils.GetFirstItem(nomCourant)
Set itemSuivant = docfils.GetFirstItem(nomSuivant)
itemCourant.Values = itemSuivant.Values
nomCourant = "mWho_" + Cstr(cpt)
nomSuivant = "mWho_" + Cstr(cpt + 1)
Set itemCourant = docfils.GetFirstItem(nomCourant)
Set itemSuivant = docfils.GetFirstItem(nomSuivant)
itemCourant.Values = itemSuivant.Values
nomCourant = "mDate_" + Cstr(cpt)
nomSuivant = "mDate_" + Cstr(cpt + 1)
Set itemCourant = docfils.GetFirstItem(nomCourant)
Set itemSuivant = docfils.GetFirstItem(nomSuivant)
itemCourant.Values = itemSuivant.Values
Next
iNombre = 6
End If
nomCourant = "mIndice_" + Cstr(iNombre)
Set itemCourant = docfils.GetFirstItem(nomCourant)
itemCourant.Values = docfils.emIndice
nomCourant = "mTexte_" + Cstr(iNombre)
Set itemCourant = docfils.GetFirstItem(nomCourant)
itemCourant.Values = docfils.emTexte
nomCourant = "mWho_" + Cstr(iNombre)
Set itemCourant = docfils.GetFirstItem(nomCourant)
itemCourant.Values = docfils.emWho
nomCourant = "mDate_" + Cstr(iNombre)
Set itemCourant = docfils.GetFirstItem(nomCourant)
itemCourant.Values = docfils.emDate
Exit Sub ' sortie pour ne pas passer dans erreur si on n'en a pas ...
ErreurAgent :
Print "Agent ADA - ModificationsMAJ" & Str(Err) & ": " & Error$
Resume Next
End Sub
[/syntax]
[CommentairesOter]
[syntax="LotusScript"]
Sub CommentairesOter (ddoc As NotesDocument)
Dim vcmt As NotesView 'vue sur les commentaires
'en cas d'erreur on continue le processus
On Error Goto ErreurAgent
'Initialisations
Set s = New NotesSession
Set db = s.CurrentDatabase
Set vcmt = db.getview("vwCmt")
Call vcmt.Clear
Call vcmt.Refresh
Set cdoc = vcmt.GetDocumentByKey(Cstr(ddoc.IDGeneral(0)), False)
If (Not (cdoc Is Nothing)) Then
cdoc.Remove(True)
End If
Exit Sub
ErreurAgent :
Print "Agent ADA - CommentairesOter : " & Str(Err) & ": " & Error$
Resume Next
End Sub
[/syntax]
Y'a pas mal de code quand même, mais comme je te le disais sur certaines bases la plannif fonctionne pile poil
Merci de ton aide en tout cas !