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

(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.edytmode 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.edytmode 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.edytmode Then
doc.SaveOptions="0"
End If
End If
Msgbox "Операция завершена.",0,"Разослать..."
subend:
Print
Exit Sub
errhndl:
Msgbox "Произошла следующая ошибка:"+Chr$(10)+""+Error$+"",16,"Ошибка..."
If cuid.edytmode Then
Call cuid.reload
Call cuid.refresh
End If
Resume subend
saveerrhnd:
Resume subend
senderrhnd:
If k%=0 Then
Redym ers(0)
Else
Redym 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