Отправка писем с форматированием из базы Lotus на внешнюю почту

[alexkapustin]

Коллеги доброе время суток.
возможно повторюсь и подобное обсуждение было на форуме но прочел все и не нашел

проблемка вот в чем
есть лотусовая база - которая предназначеня для отправки писем из лотуса на внешние ящики
отлично все работает за исключением того что текст письма идет без форматирования. пропадает шрифт, разбивается таблица (вернее подставляется тире ----- и т.д.) в итоге приходящее письмо представляет из себя только текст.
вот примерно такой
_______________________________________________________________
gdfgfdgfdgkljdfo gjoidfgijdf
dfpgjkopfdopgifd

|------------------------------------+------------------------------------|
|jhk |hjk |
|------------------------------------+------------------------------------|
|hk |hjk |
|------------------------------------+------------------------------------|
________________________________________________________________


вот код на кнопку которая производит данную отправку

может поправите чуток
заранее спасибо

(Declaration)
Dim wksp As NotesUIWorkspace
Dim session As notessession
Dim db As notesdatabase
Dim cuid As notesuidocument
Dim mailnote As notesdocument
Dim doc As notesdocument
Dim rtitem As notesrichtextitem
Dim OrigBody As NotesRichTextItem
Dim i%,j%,k%,ar%
Dim s$
Dim v,vn,vn1,ers As Variant


(Click)

Sub Click(Source As Button)
On Error Goto errhndl
Print "Рассылка -  Подготовка..."
Set wksp = New NotesUIWorkspace
Set session = New notessession
Set cuid=wksp.CurrentDocument
If cuid.editmode Then
cuid.autoreload=False
On Error Goto saveerrhnd
Call cuid.save
On Error Goto errhndl
End If
Set db=session.currentdatabase
Set mailnote=New notesdocument(db)
Set doc=cuid.Document
mailnote.Form="Memo"
mailnote.Subject=doc.Subject
Set OrigBody = doc.GetFirstItem("Body")
Set rtitem= New notesrichtextitem(mailnote,"Body")
Call rtitem.AppendRTItem(OrigBody)
vn=doc.CList
vn1=doc.EList
v=doc.MList
k%=0
On Error Goto senderrhnd
For i%=0 To Ubound(v)
Print "Информационная рассылка - " + v(i%)
mailnote.SendTo=v(i%)
Call mailnote.Send(False)
loopfromerror:
Next i%
If k%>0 Then
Call showerrors()
End If

If doc.FlagMail(0)<>"1" Then
If cuid.autoreload=False Then ar%=True
cuid.autoreload=True
doc.FlagMail="1"
If cuid.editmode Then
Call cuid.save
Else
Call doc.save(True,False)
Call wksp.viewrefresh
End If
If ar%=True Then cuid.autoreload=False
Else
If cuid.editmode Then
doc.SaveOptions="0"
End If
End If
Msgbox "Операция завершена.",0,"Разослать..."
subend:
Print
Exit Sub
errhndl:
Msgbox "Произошла следующая ошибка:"+Chr$(10)+"'"+Error$+"'",16,"Ошибка..."
If cuid.editmode Then
Call cuid.reload
Call cuid.refresh
End If
Resume subend
saveerrhnd:
Resume subend
senderrhnd:
If k%=0 Then
Redim ers(0)
Else
Redim Preserve ers(k%)
End If
ers(k%) = vn(i%)+" "+vn1(i%)
k%=k%+1
If Msgbox("Не удается послать сообщение для:"+Chr$(10)+"'"+ers(k%-1)+"'."+Chr$(10)+Chr$(10)+"Произошла следующая ошибка:"+_
Chr$(10)+"'"+Error$+"'"+Chr$(10)+Chr$(10)+_
"Продолжить рассылку ?",4+16,"Ошибка...")=6 Then
Resume loopfromerror
Else
Call showerrors()
Resume subend
End If
End Sub



(showerrors)
Sub showerrors()
Dim cd1 As New notesdocument(db)
cd1.Hid1=ers
cd1.Hid2="Не удалось отправить следующим:"
Call wksp.dialogbox("ForMemoWarning",True,True,True,True,True,False,"Внимание...",cd1)
End Sub

 

[hosm]

Есть настройка в неймс.нсф конвертации исходящих писем, там есть вариант From Notes to Plain Text. мб, это виновато?
(Server\Configuration) Configuration Settings закладка MIME - Conversion Options - Outbound
Outbound Conversion Options
Message content: from Notes to Plain Text

 

[alexkapustin]

Есть настройка в неймс.нсф конвертации исходящих писем, там есть вариант From Notes to Plain Text. мб, это виновато?
(Server\Configuration) Configuration Settings закладка MIME - Conversion Options - Outbound
Outbound Conversion Options
Message content: from Notes to Plain Text

да действительно нашел настройку
MIME - Параметры преобразования - Исходящие - Содержимое сообщения: было установлено : Преобразовать из формата Notes в формат сообщений Интернета
заменил на :
Создать смешанный вариант включая преобразование и инкапсуляцию (ДРУГОГО НЕ БЫЛО)

Отправил сообщение
пришло без изменения форматирования жирный шрифт, таблица все хорошо
НО
присоединился файл к каждому из сообщений : encap2.ond размером 300 kb

как от него избавиться не могу понять

 

[alexkapustin]

посоветовали сделать вот так

через MIME
memo - документ письма, stream - объект NotesStream, содержащий html-код
Set mime=memo.createMIMEEntity("Body")
Call mime.setContentFromText(stream,"text/html;charset=windows-1251",ENC_IDENTITY_8BIT)
Call memo.CloseMIMEEntities(True,"Body")




решение вроде классное но я с mime не работал и врядли смогу сам реализовать. я понимаю что наглость, но может кто допишит код через mime, я его прикручу к базе и базу целиком выложу на сайт в библиотеку решений (зачем последователям изобретать велосипед, каждый просто под себя подкрутит) очень прошу....

 

[susinmn]

попробуй так

Dim s As New NotesSession
Dim db As NotesDatabase
Dim mime As NotesMIMEEntity
Dim memo As NotesDocument

Set db=s.CurrentDatabase
Set memo = db.CreateDocument	
Set result = memo.CreateMIMEEntity("Body") 
Dim hdr As NotesMIMEHeader 
Set hdr = result.CreateHeader("MIME-Version") 
Call hdr.SetHeaderValAndParams(|1.0|) 

Set mime = result.CreateChildEntity( ) 
Dim stream As NotesStream 

Set stream = s.CreateStream 
s.ConvertMIME = False ' Restore conversion

stream.WriteText {<body>Тут пишем html-текст</body>}
mime.SetContentFromText stream, "text/html; charset=Windows-1251", ENC_IDENTITY_8BIT	
'приаттачивание файлов
Set rtdoc=doc.GetFirstItem("Files")
If ( rtdoc.Type = RICHTEXT ) Then
If Not Isempty(rtdoc.EmbeddedObjects) Then
Set mime = result.CreateChildEntity( ) 
Forall object In rtdoc.EmbeddedObjects
If (object.Type = EMBED_ATTACHMENT ) Then
filepath =Environ("Temp")+"\"+Cstr(Object.Name)
Call object.ExtractFile(filepath)

tmpSource=Object.Source
i=i+1
NameSource:
If i=0 Then
Redim Preserve filenames(0)
filenames(0)=Object.Source
Else
For j=0 To Ubound(filenames)
If filenames(j)=tmpSource Then
tmpSource=Strleft(Object.Source,".")+Cstr(n)+"."+Strright(Object.Source,".")
n=n+1
Goto NameSource
End If
Next
'tmpSource=Strleft(Object.Source,".")+"_"+Cstr(n-1)+"."+Strright(Object.Source,".")
Redim Preserve filenames(Ubound(filenames)+1)
filenames(Ubound(filenames))=tmpSource
End If

tmp=Evaluate({@ReplaceSubstring(@URLEncode("UTF-8";"}+Cstr(tmpSource)+{");"%";"=")})
filename="=?utf-8?Q?"+tmp(0)+"?="

Set mime = result.CreateChildEntity( )

Set hdr = mime.CreateHeader("Content-Disposition") 
Call hdr.SetHeaderValAndParams(|attachment; filename="|+filename+|"|)
Set hdr = mime.createHeader("Content-ID")
Call hdr.setHeaderVal(filename) 
Set stream = s.CreateStream 
stream.Open filepath, "binary" 
mime.SetContentFromBytes stream, |application/octet-stream; name="|+filename+|"|, ENC_BINARY 
mime.EncodeContent ENC_BASE64 
Kill filepath
End If
End Forall		
End If
End If

Call memo.CloseMIMEEntities(True, "Body")
memo.SendTo ="Кому "
memo.Principal="От кого"
memo.INetFrom="От кого"
memo.Subject = "Тема"
Call memo.Send(False)
s.ConvertMIME = True ' Restore conversion

 

[allex]

А отправлять в HTML формате ?