Activer/Desactiver l'agent d'absence
Publié: 12 Avr 2010 à 10:16cett fonciton permet d'activer ou de desactiver l'agent d'absence d'une mail.box a distance
- Code : Tout sélectionner
Function ManageOutOfOffice(wUserName As String,wDBMail As NotesDatabase,nbEnabledAgentOOO As Boolean, nbDisplayOOODoc As Boolean,wFirstDayOut As String, wFirstDayBack As String) As String
Dim UIWork As NotesUIWorkspace
Dim DocProfile As NotesDocument
Dim dteOut As NotesDateTime
Dim dteBack As NotesDateTime
Dim AgentOOO As NotesAgent
Dim adminp As NotesAdministrationProcess
Dim nmUser As NotesName
On Error Goto ErreurHandle
ManageOutOfOffice = ""
If Trim(wUserName) = "" Then
Error 9999,"wUserName is EMpty"
Exit Function
End If
Set nmUser = New NotesName(wUserName)
If wDBMail Is Nothing Then
Error 9999,"wDBMail is Nothing"
Exit Function
End If
'cherche le document profil
Set DocProfile = wDBMail.GetProfileDocument("OutOfOfficeProfile")
If DocProfile Is Nothing Then
Error 9999,"DocProfile 'OutOfOfficeProfile' is Nothing, on Database Mail : "+wDBMail.FilePath
Exit Function
End If
If DocProfile.IsNewNote = True Or nbDisplayOOODoc Then
'si le doc profile n'existe pas l'affiche
Set UIWork = New NotesUIWorkspace
Call UIWork.DialogBox("OutOfOfficeProfile",True,True,True,False,False,False," MANAGE OUT OF OFFICE",DocProfile,True,True,False)
Call DocProfile.Save(True,False)
Set DocProfile = Nothing
Exit Function
End If
'connexion a l'agent OOO
Set AgentOOO = wDBMail.GetAgent("OutOfOffice")
If AgentOOO Is Nothing Then
Error 9999,"AgentOOO 'OutOfOffice' Is Nothing"
Exit Function
End If
'Set adminp = Session.CreateAdministrationProcess(wDBMail.Server)
'fonction non documenté
Set adminp = Session.CreateAdministrationProcessNotConnected (wDBMail.Server)
If adminp Is Nothing Then
Error 9999,"Adminp is nothing"
Exit Function
End If
'traitement en fonction que l'on doit activer ou desactiver l'agent
If nbEnabledAgentOOO = True Then
' par défaut premiere date = date du jour et derniere date 1 mois plus tard
If Trim(wFirstDayOut) = "" Then
Set dteOut = New NotesDateTime(Now)
Else
Set dteOut = New NotesDateTime(Trim(wFirstDayOut))
End If
If Trim(wFirstDayBack) = "" Then
Set dteBack = New NotesDateTime(Now)
Call dteBack.AdjustMonth(1)
Else
Set dteBack = New NotesDateTime(Trim(wFirstDayBack))
End If
Call DocProfile.ReplaceItemValue("FirstDayOut",dteOut.DateOnly)
Call DocProfile.ReplaceItemValue("FirstDayBack",dteBack.DateOnly)
Call DocProfile.Save(True,False)
Set dteOut = Nothing
Set dteBack = Nothing
'activation de l'agent
ManageOutOfOffice = AdminP.ConfigureMailAgent(nmUser.Canonical,"OutOfOffice",AgentOOO.IsActivatable,True)
Else
Call DocProfile.ReplaceItemValue("FirstDayOut","")
Call DocProfile.ReplaceItemValue("FirstDayBack","")
Call DocProfile.Save(True,False)
'desactivation de l'agent
ManageOutOfOffice = AdminP.ConfigureMailAgent(nmUser.Canonical,"OutOfOffice",AgentOOO.IsActivatable,False)
End If
Set nmUser = Nothing
Set AdminP = Nothing
Set AgentOOO = Nothing
Set DocProfile = 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 !"
ManageOutOfOffice = ""
Exit Function
End Function