Добрый день уважаемые прошу помощи:
Необходимо закинуть напоминание в почтовый ящик пользователя и чтобы после этого оно СРАЗУ у него выпрыгнуло.
Использую код. Напоминалка сразу ложиться в календарь пользователя, но выскакивает через 4-10 мин, а хотелось бы чтобы выскакивала сразу.
Думаю соль в опросе функцией CheckAlarms, но как это сделать (агент?)
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">Код</div></div><div class="sp-body"><div class="sp-content">
<!--shcode--><pre><code class='# vbscript'>Sub createReminder(username$, dateTime As NotesDateTime, popUpStr As String, subjectStr As String, doc As NotesDocument )
Dim db As NotesDatabase
Dim s As New NotesSession
Dim userMailDb As New NotesDatabase( "", "" )
Dim reminderDoc As NotesDocument
Dim DTItem As NotesItem
Dim us As NotesName
Dim item As NotesItem
Set db=s.currentdatabase
' данные полного ФИО и почтового ящика берем из АК - ($My_Users)
Set dbAK = s.GetDatabase (db.Server, "names.nsf")
Set viewAK = dbAK.GetView ("($Users)")
Set vcAK = viewAK.GetAllEntriesByKey (username$, True)
Set entryAK = vcAK.GetFirstEntry
If entryAK Is Nothing Then
' НЕТ такого сотрудника.
Else
MailServer = entryAK.ColumnValues(5)
MailFile = entryAK.ColumnValues(6)
' получаем почтовую базу
Set userMailDb = s.GetDatabase (MailServer, MailFile)
If userMailDb Is Nothing Then
Print "Ошибка при создании напоминания, невозможно открыть почтовый ящик пользователя..."
Else
Set UsrName = New NotesName(s.UserName)
' Создадим документ
Print "Создаем напоминание ..."
Set reminderDoc=userMailDb.CreateDocument
With reminderDoc
.ReplaceItemValue "TimeSheetReminder","1"
'Добавляем для поиска
.ReplaceItemValue "$Alarm", 1
.ReplaceItemValue "$AlarmDescription", popUpStr
.ReplaceItemValue "$AlarmMemoOptions", ""
.ReplaceItemValue "$AlarmOffset", -1
' окно выпрыгет за минуту до заданного времени
.ReplaceItemValue "$AlarmSound","tada"
.ReplaceItemValue "$AlarmUnit", "M"
.Replaceitemvalue "$AltPrincipal",CStr(UsrName.Canonical)
.Replaceitemvalue "$CSFlags","c"
.Replaceitemvalue "$CSVersion","2"
.Replaceitemvalue "$NoPurge",Enddt
.Replaceitemvalue "$PublicAccess","1"
.Alarms = "1"
.AltChair=UsrName.Canonical
.AppointmentType = "4" '4 - напоминание
.ApptUNID=CStr(reminderDoc.UniversalID)
.Chair=CStr(UsrName.Canonical)
.EndDate = dateTime.DateOnly
.EndDateTime=dateTime.lsLocaltime
.EndTime = dateTime.TimeOnly
.ExcludeFromView = ExcludeFromView '"D;S" ' скрытие во вьюхах.
.Form = "Appointment"
.Replaceitemvalue "From",UsrName.Canonical
.MeetingType="1"
.OrgTable="C0"
.Principal=CStr(UsrName.Canonical)
.SchedulerSwitcher="1"
.SequenceNum=1
.StartDate = dateTime.lsLocaltime
.StartTime = dateTime.TimeOnly
.STARTDATETIME=dateTime.lsLocaltime
.Subject = subjectStr
.tmpAdditionalInviteeButton="1"
.tmpAdditionalRoomsButton="1"
.tmpAppointmentType="Reminder"
.tmpAppointmentType_1="Reminder"
.tmpChair=Usrname.Canonical
.tmpEventLabel="Reminder"
.tmpOwnerHW="0"
.tmpParticipantHW="1"
.tmpRW="1"
.tmpShowTZ="0"
.txtNum="5"
.UpdateSeq=1
.WebDateTimeInit="1"
.ReplaceItemValue "_viewIcon", 124
.ComputeWithForm True, False
.Save True, False
.PutInFolder( "$Alarms" )
txtstr$ = "запихали в базу " + CStr (userMailDb.Title) + " напоминание " + .Subject(0)
Print txtstr$
End With
Print "Успешное создание напоминания..."
End If
End If
End Sub[/CODE]
Необходимо закинуть напоминание в почтовый ящик пользователя и чтобы после этого оно СРАЗУ у него выпрыгнуло.
Использую код. Напоминалка сразу ложиться в календарь пользователя, но выскакивает через 4-10 мин, а хотелось бы чтобы выскакивала сразу.
Думаю соль в опросе функцией CheckAlarms, но как это сделать (агент?)
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">Код</div></div><div class="sp-body"><div class="sp-content">
<!--shcode--><pre><code class='# vbscript'>Sub createReminder(username$, dateTime As NotesDateTime, popUpStr As String, subjectStr As String, doc As NotesDocument )
Dim db As NotesDatabase
Dim s As New NotesSession
Dim userMailDb As New NotesDatabase( "", "" )
Dim reminderDoc As NotesDocument
Dim DTItem As NotesItem
Dim us As NotesName
Dim item As NotesItem
Set db=s.currentdatabase
' данные полного ФИО и почтового ящика берем из АК - ($My_Users)
Set dbAK = s.GetDatabase (db.Server, "names.nsf")
Set viewAK = dbAK.GetView ("($Users)")
Set vcAK = viewAK.GetAllEntriesByKey (username$, True)
Set entryAK = vcAK.GetFirstEntry
If entryAK Is Nothing Then
' НЕТ такого сотрудника.
Else
MailServer = entryAK.ColumnValues(5)
MailFile = entryAK.ColumnValues(6)
' получаем почтовую базу
Set userMailDb = s.GetDatabase (MailServer, MailFile)
If userMailDb Is Nothing Then
Print "Ошибка при создании напоминания, невозможно открыть почтовый ящик пользователя..."
Else
Set UsrName = New NotesName(s.UserName)
' Создадим документ
Print "Создаем напоминание ..."
Set reminderDoc=userMailDb.CreateDocument
With reminderDoc
.ReplaceItemValue "TimeSheetReminder","1"
'Добавляем для поиска
.ReplaceItemValue "$Alarm", 1
.ReplaceItemValue "$AlarmDescription", popUpStr
.ReplaceItemValue "$AlarmMemoOptions", ""
.ReplaceItemValue "$AlarmOffset", -1
' окно выпрыгет за минуту до заданного времени
.ReplaceItemValue "$AlarmSound","tada"
.ReplaceItemValue "$AlarmUnit", "M"
.Replaceitemvalue "$AltPrincipal",CStr(UsrName.Canonical)
.Replaceitemvalue "$CSFlags","c"
.Replaceitemvalue "$CSVersion","2"
.Replaceitemvalue "$NoPurge",Enddt
.Replaceitemvalue "$PublicAccess","1"
.Alarms = "1"
.AltChair=UsrName.Canonical
.AppointmentType = "4" '4 - напоминание
.ApptUNID=CStr(reminderDoc.UniversalID)
.Chair=CStr(UsrName.Canonical)
.EndDate = dateTime.DateOnly
.EndDateTime=dateTime.lsLocaltime
.EndTime = dateTime.TimeOnly
.ExcludeFromView = ExcludeFromView '"D;S" ' скрытие во вьюхах.
.Form = "Appointment"
.Replaceitemvalue "From",UsrName.Canonical
.MeetingType="1"
.OrgTable="C0"
.Principal=CStr(UsrName.Canonical)
.SchedulerSwitcher="1"
.SequenceNum=1
.StartDate = dateTime.lsLocaltime
.StartTime = dateTime.TimeOnly
.STARTDATETIME=dateTime.lsLocaltime
.Subject = subjectStr
.tmpAdditionalInviteeButton="1"
.tmpAdditionalRoomsButton="1"
.tmpAppointmentType="Reminder"
.tmpAppointmentType_1="Reminder"
.tmpChair=Usrname.Canonical
.tmpEventLabel="Reminder"
.tmpOwnerHW="0"
.tmpParticipantHW="1"
.tmpRW="1"
.tmpShowTZ="0"
.txtNum="5"
.UpdateSeq=1
.WebDateTimeInit="1"
.ReplaceItemValue "_viewIcon", 124
.ComputeWithForm True, False
.Save True, False
.PutInFolder( "$Alarms" )
txtstr$ = "запихали в базу " + CStr (userMailDb.Title) + " напоминание " + .Subject(0)
Print txtstr$
End With
Print "Успешное создание напоминания..."
End If
End If
End Sub[/CODE]