В
Вас
у пользователя в интерфейсе есть кнопка отправить уведомление, которая отсылает электронное письмо на почту пользователя(эта часть работает) и параллельно я вычисляю поле и заполняю его другими электронными адресами(это тоже работает) дописал код в кнопке чтобы переопределялся массив и заполнялся новый элемент массива этими адресами и по идее должно бы работать но нет...
Код:
Sub Click(Source As Button)
' Уведомление WF
Dim ws As New notesuiworkspace
Dim sess As New NotesSession
Dim db As NotesDatabase
Dim clview As NotesView
Dim cldoc As NotesDocument
Dim cuid,ruid As notesuidocument
Dim curdoc As NotesDocument
Dim Usluga As String
Dim mailbox As NotesDatabase
Dim item As NotesItem
Dim rtitem As NotesRichTextItem
Dim configview As NotesView
Dim configdoc As NotesDocument
Dim doc As NotesDocument
Dim rtrange As NotesRichTextRange
Dim fname, mname,lname, RNumber_Full, RDate As String
Set cuid = ws.CurrentDocument
Set curdoc = cuid.document
usluga = curdoc.GetItemValue( "QuestionList" )(0)
If usluga = "" Then Msgbox "Услуга не определена", , "Error"
Set db = sess.CurrentDatabase
Set clview = db.GetView("class4")
Set cldoc= clview.GetDocumentByKey( usluga )
' =============Получение значений из классификатора====
zn = cldoc.GetItemValue("regNotTxt")(0)
If zn="" Then Msgbox "В классификаторе не заполнен текст уведомления", , "Error"
Set mailbox = sess.GetDatabase(db.Server, "mail.box")
' Определяем фаил настройки и адрес отправителя
Set configview = db.getView("(CfgSOA)")
Set configdoc = configview.getFirstDocument()
If configdoc Is Nothing Then Msgbox "Не найден документ настройки отправки сообщений" , ,"Error"
Dim arMail As Variant
arMail = configdoc.GetItemValue( "CfgMailAddress" )
If Isarray(arMail) Then
fr = arMail(0)
Else
fr = arMail
End If
If fr ="" Then Msgbox "В документе настройки отправки сообщений не указан E-mail" , , "Error"
' Определяем адрес получателя
Dim arRec As Variant
arRec = curdoc.GetItemValue("email")
If Isarray(arRec) Then
rec = arRec(0)
Else
rec = arRec
End If
If rec ="" Then Msgbox "В РКК документа не указан E-mail" , , "Error"
этот участок кода дописан но не знаю как проверить работает ли он
---------------------------------------------------------
ReDim preserve arRec(ubound(arRec)+1)
arRec(ubound(arRec))= curdoc.GetItemValue("email_3")(0)
rec=arRec
--------------------------------------------------------
' Создаем почтовый фаил
Set mdoc = mailbox.CreateDocument
Set item = New NotesItem(mdoc, "Form", "Memo")
item.IsSummary = True
Set item = New NotesItem(mdoc, "From", fr)
item.IsSummary = True
Set item = New NotesItem(mdoc, "SendTo", rec)
item.IsSummary = True
Set item = New NotesItem(mdoc, "Recipients", rec)
item.IsSummary = True
Set item = New NotesItem(mdoc, "Subject", "Уведомление о регистрации")
item.IsSummary = True
Set item = New NotesItem(mdoc, "RDate", Now )
item.IsSummary = True
' В почтовом файле создаем и заполняем тело письма
Set rtitem = mdoc.CreateRichTextItem( "body" )
Call rtitem.AppendText(zn)
Call rtitem.AppendText("Письмо создано автоматически системой электронного документооборота." & Chr(13) + Chr(10))
Call rtitem.AppendText("Отвечать на него не нужно!")
' Определяем параметры для вставки
fname = curdoc.GetItemValue("FName")(0)
lname = curdoc.GetItemValue("LName")(0)
mname= curdoc.GetItemValue("MName")(0)
RNumber_Full = curdoc.GetItemValue("RNumber_Full")(0)
RDate = curdoc.GetItemValue("RDate")(0)
Set rtrange = rtitem.CreateRange
Call rtrange.FindAndReplace("(%номеррег%)",RNumber_Full)
Call rtrange.FindAndReplace("(%датарег%)",RDate)
Call rtrange.FindAndReplace("(%Фамилия%)",lname)
Call rtrange.FindAndReplace("(%Имя%)",fname)
Call rtrange.FindAndReplace("(%Отчество%)",mname)
' Отправляем письмо
Call mdoc.save(True,True)
Call curdoc.ReplaceItemValue( "noticestatus", "EmailComplete" )
Call curdoc.save(True,True)
End Sub
Последнее редактирование модератором: