Метод создания и отправки писем через Lotus Notes позволяет указать тему и текст
письма, прикреплять файлы, указывать получателей сообщения. Создает письмо от
имени текущего пользователя. В момент работы процедуры Lotus Notes должен быть
открыт.
'Метод отправки писем через Lotus Notes
'@param strSendTo() - массив строк адресов эл. почты получателей сообщения
'@param strCopyTo() - массив строк адресов эл. почты получателей копий сообщения
'@param strSubject - тема письма
'@param AttachPath()- массив строк с путями к файлам
'@param LetterText()- массив строк текста сообщения
'@param SendStatus - состояние сохранения письма перед отправкой
'@param ClearStatus - очищать ли тело письма перед заполнением
Public Sub SendFromLotus_Manual( _
strSendTo() As String, strCopyTo() As String, strSubject As String, _
AttachPath() As String, LetterText() As String, SendStatus As Boolean, _
ClearStatus As Boolean)
Dim UserName As String, MailDbName As String
Dim ccRecipient As String, attachment1 As String, Recipient As String
Dim Maildb As Object, MailDoc As Object, AttachME As Object
Dim Session As Object, UIdoc As Object
Dim EmbedObj1 As Object, WorkSpace As Object
Dim znach As Variant, Dopolnenie As String
'Открываем и определяем пользователя
On Error Resume Next
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = _
Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Not Maildb.IsOpen Then Maildb.OPENMAIL
'Создаем новое письмо
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
'Преобразовываем массив адресов в строку и заполняем поле "Кому"
MailDoc.sendTo = strSendTo
'Преобразовываем массив адресов в строку и заполняем поле "Копия"
MailDoc.CopyTo = strCopyTo
'Заполняем поле "Тема" (Subject)
MailDoc.Subject = strSubject
'MailDoc.Body = strBodyText
'Состояние сохранения письма при отправке
MailDoc.SaveMessageOnSend = SendStatus
'Прикрепляем вложения
For Each znach In AttachPath
If Len(znach) > 0 Then
Recipient = Recipient & ", " & znach
Set AttachME = MailDoc.CreateRichTextItem(Mid(znach, InStrRev(znach, "\") + 1))
Set EmbedObj1 = AttachME.EMBEDOBJECT(1454, Mid(znach, InStrRev(znach, "\") + 1), znach, "")
End If
Next znach
'Показываем письмо пользователю
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.EDITDOCUMENT(True, MailDoc).GOTOFIELD("Body")
Set UIdoc = WorkSpace.CurrentDocument
'Переходим к телу письма
Call UIdoc.GOTOFIELD("Body")
'Очищаем все содержимое тела письма
If ClearStatus Then
Call UIdoc.SelectAll
Call UIdoc.Clear
End If
'Вставляем текст письма по абзацу на элемент массива
For Each znach In LetterText
Call UIdoc.InsertText(znach)
Call UIdoc.InsertText(Chr(10))
Next znach
Call objDocument.Save(False, False, True)
'AppActivate "Lotus Notes"
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Set UIdoc = Nothing
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
End Sub
|