Воскресенье, 28.04.2024, 13:48
Приветствую Вас Гость | RSS
Меню сайта
Вход на сайт
Поиск
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0

Разработка приложений для бизнеса в MS Office

Каталог статей

Главная » Статьи » MS Excel VBA » Отправка почтовых сообщений

Отправка писем через Lotus Notes

Метод создания и отправки писем через 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
Категория: Отправка почтовых сообщений | Добавил: Johnjc82 (09.02.2015)
Просмотров: 2011 | Комментарии: 2 | Теги: отправка, создание, Lotus, VBA, e-mail, Lotus Notes, excel, письмо | Рейтинг: 0.0/0
Всего комментариев: 2
avatar
1 ninesku • 13:54, 01.06.2018
Call UIdoc.InsertText(Chr(10))
Подскажите, пожалуйста,  
1. как текст отформатировать (размер, цвет шрифта)?
2. Вставить текст с гиперссылкой
avatar
2 ninesku • 13:56, 01.06.2018
И спасибо огромное за этот скрипт, просто жизнь спасает!
avatar