Certains m'ont aiguillé vers la sandbox (merci Stéphane) et je vous ai promis mon code en retour... c'est chose faite...
Un j'ai créé une synthèse serveur. J'ai donc défini pour cela un doc comportant les champs :
Nom du serveur
Date de prise
et les différents champs cumuls (accès, lus, écrits)
puis pour afficher tout cela une vue qui va bien
pour l'activité utilisateur
idem j'ai créé un masque comportant :
nom de l'utilisateur
date de prise
nb total lus
nb total écrit
puis un RT contenant l'historique de la journée où je renseigne l'heure, lus et écrits du moment
une vue utilisateur qui va bien et une vue INDEX afin d'enregistrer un document par jour
vindex comporte une colonne sur la clef UA_Key=commonusername+aaaammjj et en supprimant tous les espaces pour avoir une clef compacte
on programme cet agent sur tous les serveurs et par le biais des réplication on a l'activité de toute la base...
voili voilà...
le code ci-dessous vous en dira plus....
- Code : Tout sélectionner
Sub Initialize
Dim ua As NotesUserActivity
Dim uae As NotesUserActivityEntry
Dim iCounter As Long
Dim viewUA As NotesView
Dim docUA As NotesDocument
Dim viewSA As NotesView
Dim docSA As NotesDocument
Dim rtUA As Variant
Dim nns As NotesName
Dim nnu As NotesName
Dim ks As String
Dim ku As String
Dim ndt As NotesDateTime
Dim ndtu As NotesDateTime
Dim ndtFirst As NotesDateTime
Dim ndtLast As NotesDateTime
Dim dbt As notesdatabase
Dim nbj As Long
Dim jour As String
On Error Goto handleError
Call loadSession
Set ndt=New NotesDateTime(Now)
Set db=session.CurrentDataBase
If db Is Nothing Then Exit Sub
If Not db.isOpen Then Exit Sub
Set ua = New NotesUserActivity(db)
If Not ua.HasUserActivity Then Exit Sub
'// synthèse du serveur
Set nns=New NotesName(db.Server)
ks=nns.Common
Set viewSA=db.GetView("VSA")
Set docSA=viewSA.GetDocumentByKey(ks)
If docSA Is Nothing Then
Set docSA=New NotesDocument(db)
docSA.Form="SA"
docSA.SA_Nom=ks
End If
docSA.SA_Date=Cdat(ndt.DateOnly)
docSA.SA_TotJour=ua.Uses
docSA.SA_EcritsJour=ua.Writes
docSA.SA_LusJour=ua.Reads
docSA.SA_TotHier=ua.PrevDayUses
docSA.SA_EcritsHier=ua.PrevDayWrites
docSA.SA_LusHier=ua.PrevDayReads
docSA.SA_TotSemDer=ua.PrevWeekUses
docSA.SA_EcritsSemDer=ua.PrevWeekWrites
docSA.SA_LusSemDer=ua.PrevWeekReads
docSA.SA_TotMois=ua.PrevMonthUses
docSA.SA_EcritsMois=ua.PrevMonthWrites
docSA.SA_LusMois=ua.PrevMonthReads
docSA.SA_PremierJour=ua.First
docSA.SA_DernierJour=ua.Last
Set ndtFirst=New NotesDateTime(ua.first)
Set ndtLast=New NotesDateTime(ua.last)
nbj= Int(ndtLast.TimeDifference( ndtFirst)/86400)
docSA.SA_NbJours=nbj
Call docSA.Save(True,False)
'// Accès utilisateurs
Set viewUA=db.Getview("VINDEXUA")
For iCounter = 1 To ua.UserActivityCount
Set uae = ua.GetNthUserActivityEntry(iCounter)
Set nnu=New NotesName(uae.UserName)
Set ndtu=New NotesDateTime(uae.Time)
jour=Right$(ndtu.DateOnly,4)+Mid$(ndtu.DateOnly,4,2)+Left$(ndtu.DateOnly,2)
ku=Ucase$(nnu.Common+jour)
Call replaceSubstring(ku," ","")
Set docUA=viewUA.GetDocumentByKey(ku)
If docUA Is Nothing Then
Set docUA=New NotesDocument(db)
docUA.Form="UA"
docUA.UA_Key=ku
docUA.UA_Nom=nnu.Common
docUA.UA_Date=Cdat(ndtu.DateOnly)
docUA.UA_Lus=uae.Reads
docUA.UA_Ecrits=uae.Writes
Set rtUA=New NotesRichTextitem(docUA,"UA_Body")
Call viewUA.refresh
Else
docUA.UA_Lus=docUA.UA_Lus(0)+uae.Reads
docUA.UA_Ecrits=docUA.UA_Ecrits(0)+uae.Writes
Set rtUA=docUA.GetFirstitem("UA_Body")
End If
Call rtUA.AppendText(ndtu.TimeOnly)
Call rtUA.AddTab(1)
Call rtUA.AppendText(Cstr(uae.Reads))
Call rtUA.AddTab(1)
Call rtUA.AppendText(Cstr(uae.Writes))
Call rtUA.AddNewLine(1)
Call docUA.Save(True,False)
Next iCounter
Exit Sub
handleError:
If session.isOnServer Then
Print "Erreur ";Err;" ";Error$;" ligne ";Erl
Else
Msgbox "Erreur " & Err & " - " & Error$ & " ligne " & Erl,16,"UserActivity"
End If
Resume fin
fin:
End Sub
Function replaceSubString(tmpString As String, oldString As String, newString As Variant) As Integer
Dim position As Integer
Dim lenOldString As Integer
If tmpString = "" Then
replaceSubString = True
Exit Function
End If
lenOldString = Len(oldString)
position = Instr(tmpString, oldString)
Do While position > 0 And oldString <> ""
tmpString = Left(tmpString, position - 1) & newString & Mid(tmpString, position + lenOldString)
position = Instr(position + Len(newString), tmpString, oldString)
Loop
replaceSubString = True
End Function
