Программное прикрепление файла с иконкой в рич поле на LotusScript.

Sub Click(Source As Button)
    On Error Goto ErrH
    Dim uidoc As NotesUIDocument
    Dim ses As New NotesSession, ws As New NotesUIWorkspace
    Dim doc As NotesDocument
    Set uidoc =ws.CurrentDocument
    Set doc =uidoc.Document
    Dim html As Variant
    ses.convertmime=False
    Dim stream As NotesStream
    Set stream = ses.CreateStream
    Call stream.WriteText("ПРИМЕР <b>как можно</b> использовать <font color=red>HTML</font>")
    Dim mime As NotesMIMEEntity
    Set mime = doc.CreateMIMEEntity
    Dim header As NotesMIMEHeader
    Set header = mime.CreateHeader("headermime")
    Call header.SetHeaderVal("text Header")
    Call mime.SetContentFromText (stream, "text/plain;charset=UTF-8", ENC_BASE64)
    
    
    Call doc.Save(True, True)
    doc.body2= doc.body
    
    ses.ConvertMIME = True
    Call Stream.Close()
    
    Exit Sub
ErrH:
    Print "Ошибка " & Error(Err) & " в строке " & Erl    
    Exit Sub

vAttachList := @AttachmentNames;

vStop := @If(@Attachments=0;"1";"0");

@If(vStop="0";

@Do(vSourceName:=@If(@Attachments>1; @Prompt([OkCancelList];"Выбрать файл";"Выбор файла для переименования";"";vAttachList);vAttachList);

vNewName:=@Prompt([OkCancelEdit];"Новое имя";"Новое имя";vSourceName);
vNewName:="C:\\XML\\" + vNewName;

@Command([EditDetach];vSourceName; vNewName);



@Command([EditGotoField];"Body2");
@Command([EditInsertFileAttachment] ; vNewName ; "1")
);


@Prompt([Ok];"Action - File rename - cancelled!";"The document does not contain any attachments!"))

Sub Click(Source As Button)
    On Error Goto ErrH
    Dim uidoc As NotesUIDocument
    Dim session As New NotesSession, ws As New NotesUIWorkspace, CurDataBase As NotesDataBase
    Dim doc As NotesDocument
    Set uidoc =ws.CurrentDocument
    Set doc =uidoc.Document
    Set CurDataBase=session.CurrentDataBase
    
    Dim docR As NotesDocument'документ TMP'
    Set docR = New NotesDocument( CurDataBase ) ' создали новый док в базе роутер
    docR.Form="outgoing"
    docR.header ="TEST TMP"
    docR.adresed = "1"
    docR.isp = "1"
    
    session.ConvertMIME = False
    Dim streamIn As NotesStream
    Set streamIn =  session.CreateStream 
    Call streamIn.Open("C:\XML\excel.xlsx",  "UTF-8")
    Call streamIn.Truncate
    
    Dim body As NotesMIMEEntity, header As NotesMIMEHeader ,  child As NotesMIMEEntity
    Set body = docR.CreateMIMEEntity("Body")
    Set header = body.CreateHeader("Content-Type")
    Call header.SetHeaderValAndParams({multipart/alternative;charset="UTF-8"})
    Set child = body.createChildEntity() 'ChildEntities are containers
    
    Set header = child.CreateHeader("Content-Type")
    Call header.SetHeaderVal("vnd.openxmlformats-officedocument.spreadsheetml.sheet")
    
    Set header = child.CreateHeader("Content-Disposition")
    Call header.SetHeaderVal("attachment; filename=excel.xlsx")
    
    
    Set header = child.CreateHeader("Content-ID")
    Call header.SetHeaderVal("excel.xlsx")
    
    Call child.SetContentFromBytes(streamIn, "attachment; filename=excel.xlsx", ENC_BASE64)
    
    'Call child.setContentFromText(streamIn, {"application/octet-stream"}, ENC_IDENTITY_BINARY)     ENC_BASE64   ENC_EXTENSION    ENC_NONE
    
    
    Call docR.Save(True, True    )
    Call streamIn.Close()
    Call docR.Closemimeentities(True)
    
    
    Call ws.EditDocument(True, docR)  '  False - чтение
    Print "OK"
    
    'Dim ftuidoc As NotesUIDocument
    'Set ftuidoc = ws.EditDocument( True, docR , True ,  , True, False )
    'Call ftuidoc.GoToField( "Body" )
    'Call ftuidoc.SelectAll
    'Call ftuidoc.Copy
    'Call ftuidoc.Close(True)
    
    'Call uidoc.GoToField( "Body" )    
    'Call uidoc.Paste
    'Call uidoc.Refresh    
    
    'Call ftuidoc.Close
    
    Print "USE"
    
    Exit Sub
ErrH:
    Print "Ошибка " & Error(Err) & " в строке " & Erl    
    Exit Sub
End Sub