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

Sub Click(Source As Button)
    On Error Goto ErrH
    Dim session As New NotesSession, ws As New NotesUIWorkspace, db As NotesDatabase, sview As NotesView, dc As NotesDocumentCollection
    Dim uidoc As NotesUIDocument, doc As NotesDocument, templdoc As NotesDocument, DocTemp As NotesDocument
    Dim picklist As Variant, mes As String
    Dim rtitem As NotesRichTextItem
    Dim rtitem2 As NotesRichTextItem
    Dim Name_Stncl_List()  As Variant, Name_Stncl_List_matr() As Variant  ' все имена вложений
    
    Set doc = ws.CurrentDocument.Document
    Set uidoc=ws.CurrentDocument
    Call uidoc.save
    
    Set rtitem = doc.GetFirstItem("attach")
    
    Dim xxxx As  Integer
    i=0
    If ( rtitem.Type = RICHTEXT ) Then 
        If Not Isempty(rtitem.EmbeddedObjects) Then  
            Forall obj In rtitem.EmbeddedObjects
                If obj.Type = EMBED_ATTACHMENT Then   ' шаг 1 имена вложений в массив
                    If obj.FileSize=0 Then
                        xxxx =     Messagebox     ({"Приложение:  } & obj.Source & { имеет размер 0 байт.} & Chr(13) & Chr(13)   & {Удалить?"}, 1 , "Удаление нулевого вложения." ) 
                        If xxxx = 1 Then
                            doc.history= Cstr(Now)   + " "+ session.CommonUserName + " удалено приложение размером 0 байт ("  + obj.Source + ") "   &Chr(13) & " "&Chr(13) &  doc.history(0)
                            Call  obj.Remove
                            doc.ReplaceItemValue({SaveOptions},{0}).SaveToDisk=False
                            Call doc.save (True,False)
                            Call uidoc.Close
                            Call ws.EditDocument(True, doc)  '  False - чтение
                            Exit Sub
                        End If
                        
                    Else
                        Redim Preserve Name_Stncl_List(i)        
                        Name_Stncl_List(i)=    obj.Source    &  {|}&   obj.Name '    в Name_Stncl_List вносим имена вложений (Source) и   альясы (Name)
                        
                        i=i+1
                    End If
                End If                
            End Forall
        End If
    End If        
    
    If i>0 Then        'есть  хоть одно вложение в поле атач
        Set DocTemp = doc.ParentDatabase.CreateDocument
        DocTemp.ReplaceItemValue  "Name_ListAttach", Name_Stncl_List   ' скрытое поле Name_ListAttach на диалог формне с  Source   |  Name
        
        If Not    ws.DialogBox("ChooseDlg",True,True,False,False,False,False,"Переименовать ",doctemp, True) Then Exit Sub
        
        nameobj2 =  doctemp.ListAttach(0)
        Print "---"
        Print nameobj2         '  псевдоним Name
    End If
    
    datapatch$ = "C:\XML\"
    If  Dir$ (datapatch$ ,16 )="" Then 
        Mkdir datapatch$
    End If
    
    i=1 
    Forall obj In rtitem.EmbeddedObjects
        If obj.Name = nameobj2  Then   ' nameobj2 - ямя выбранного вложения (псевдоним)
            Dim object3 As NotesEmbeddedObject
            Set object3 =     rtitem.GetEmbeddedObject(nameobj2)
            Print "object3.Source " object3.Source
            new_nameobj=Trim(Inputbox$("Введите новое имя приложения "  & i ,"Ввод названия приложения",Strleftback(object3.Source,".")   ))       '  строка слева от первой точки ( без расширения)
            If new_nameobj="" Then Exit Sub
            
            new_nameobj = new_nameobj & "." & Strrightback (object3.Source,".")    '   имя + расширение файла
            
            If new_nameobj<>nameobj2 Then   '  надо переименовать
                Call obj.ExtractFile( datapatch$ & nameobj2) 
                Name datapatch$ & nameobj2   As  datapatch$ & new_nameobj   '  переименовать файл nameobj на диске в new_nameobj
                'Call rtitem.EmbedObject ( EMBED_ATTACHMENT, "", datapatch$ & new_nameobj)
                Call session .SetEnvironmentVar( "OutFiles", datapatch$ & new_nameobj )
                Call ws.URLOpen( "javascript: document.forms[0].testkn.click();" )
                
                Call  obj.Remove
                Call uidoc.Refresh
            '    Kill  datapatch$ & new_nameobj
            End If
            
        End If
        i=i+1 
    End Forall
    
    Call    doc.Save(1,0)
    Print "Сохранили."
    doc.history= Cstr(Now)      + " "+  session.CommonUserName + " переименовано  приложение ("  + new_nameobj  + ") "   &Chr(13) & " "&Chr(13) &  doc.history(0)
    
    doc.ReplaceItemValue({SaveOptions},{0}).SaveToDisk=False
    Call doc.save (True,False)
    Call uidoc.Close
    Call ws.EditDocument(True, doc)  '  False - чтение
    
    
    Exit Sub
    
ErrH:
    Print "Ошибка " & Error(Err) & " в строке " & Erl    
    Exit Sub
End Sub

Files := @Text(@Environment("OutFiles"));
@Command([EditGotoField];"attach");
@Command([EditInsertFileAttachment] ; Files );
@Command([Execute]; "cmd.exe"; "/C  del " + Files)