- Code : Tout sélectionner
Option Public
Option Explicit
%INCLUDE "LSCONST.LSS"
Const IFB_SERVEUR = {NT2}
Const IFB_ANNUAIRE = {names.nsf}
Const IFB_VUE_ANNUAIRE = {($NamesFieldLookup)}
Const IFB_EXT = {.nsf}
Public Function EntreAnnuaire(vUtilisateur As Variant, _
sDateDebut As String, _
sDateFin As String, _
sMesssageAlerte As String, _
sSujet As String, _
sLieu As String, _
sType As String, _
sCategories As String, _
iTemps As Integer, _
iIcon As Integer _
) As Integer
%REM
Fonctions : Créer des entrées dans n'importe quel calendrier Notes sur le serveur
===========
Paramètres :
============
vUtilisateur : Utilisateur à qui ont fait une entrée
sDateDebut : Date de début
sDateFin : Date de fin
sMessageAlerte : Message qui apparaït lors de l'alerte
sSujet : Sujet de l'entrée dans l'agenda
sLieu : Lieu ou ce trouve la réunion
sType : Type d'entrée
sCategories : Catégories ou doit être classé l'entrée
iTemps : Quand est ce que doit être lancé l'alerte, un chiffre moins veut dire avant et un chiffre positif veut dire après
iIcon : Numéro de l'icône
Résultat :
==========
Vrai : Si tout est correct
Faux : En cas d'erreur
%END REM
' Variables
Dim Session As New NotesSession
Dim DbNames As NotesDatabase
Dim DbMail As New NotesDatabase("", "")
Dim VueNames As NotesView
Dim ColNames As NotesDocumentCollection
Dim DocNames As NotesDocument
Dim DocCalendar As NotesDocument
Dim sDbMail As String
Dim sUtilisateur As String
Dim tmpDateDebut As NotesDateTime
Dim tmpDateFin As NotesDateTime
' Gestion des erreurs
On Error Goto err_EntreAnnuaire
sUtilisateur = vUtilisateur.CommonUserName
Set tmpDateDebut = New NotesDateTime(sDateDebut)
Set tmpDateFin = New NotesDateTime(sDateFin)
Set DbNames = Session.GetDatabase(IFB_SERVEUR, IFB_ANNUAIRE)
If (Not DbNames.IsOpen) Then
Call DbNames.Open("", "")
If (Not DbNames.IsOpen) Then Goto err_EntreAnnuaire
End If
Set VueNames = DbNames.GetView(IFB_VUE_ANNUAIRE)
Set ColNames = VueNames.GetAllDocumentsByKey(sUtilisateur)
If ColNames.Count = 1 Then
Set DocNames = ColNames.GetFirstDocument
sDbMail = DocNames.MailFile(0)
If sDbMail = "" Then
Messagebox "L'utilisateur : " & sUtilisateur & " n'à pas de messagerie", MB_OK + MB_ICONSTOP, "Pas de messagerie"
Goto err_EntreAnnuaire
End If
Elseif ColNames.Count > 1 Then
Messagebox "Vous avez un doublon dans votre annuaire. Utilisateur : " & sUtilisateur, MB_OK + MB_ICONSTOP, "Erreur de doublon"
Goto err_EntreAnnuaire
Elseif ColNames.Count = 0 Then
Messagebox "L'utilisateur : " & sUtilisateur & " n'existe pas", MB_OK + MB_ICONSTOP, "Utilisateur inconnu"
Goto err_EntreAnnuaire
End If
sDbMail = sDbMail & IFB_EXT
Call DbMail.Open(IFB_SERVEUR, sDbMail)
If (Not DbMail.IsOpen) Then
Call DbMail.Open("", "")
If (Not DbMail.IsOpen) Then Goto err_EntreAnnuaire
End If
Set DocCalendar = New NotesDocument(DbMail)
With DocCalendar
.ReplaceItemValue "$Alarm", 1
.ReplaceItemValue "$AlarmDescription", sMesssageAlerte
.ReplaceItemValue "$AlarmMemoOptions", ""
.ReplaceItemValue "$AlarmOffset", iTemps
.ReplaceItemValue "$AlarmUnit", "M"
.ReplaceItemValue "_ViewIcon", iIcon
.Form = "Appointment"
.Subject = sSujet
.Alarms = "1"
.Location = sLieu
.Categories = sCategories
.CalendarDateTime = tmpDateDebut.LSLocalTime
.StartDate = tmpDateDebut.LSLocalTime
.StartTime = tmpDateDebut.LSLocalTime
.StartDateTime = tmpDateDebut.LSLocalTime
.EndDate = tmpDateFin.LSLocalTime
.EndDateTime = tmpDateFin.LSLocalTime
.AppointmentType = sType
.ComputeWithForm False, False
.Save True, False
.PutInFolder("$Alarms")
End With
EntreAnnuaire = True
Exit Function
err_EntreAnnuaire:
EntreAnnuaire = False
End Function