Редактирование вложений

Sub Click(Source As Button)
    On Error Goto er
    Dim ws As New NotesUIWorkspace
    Dim varAttachmentNames As Variant, vPrompt As Variant, handleV As Variant
    Dim strTempPath As String, fname As String, mes As String
    Dim uidoc As NotesUIDocument
    Dim doc As NotesDocument
    Dim rtitem As NotesRichTextItem
    Dim vFile As NotesEmbeddedObject
    Print "RED"
    Set uidoc = ws.CurrentDocument
    uidoc.EditMode = True
    Call uidoc.Refresh(True)
    
    Set doc = uidoc.Document
    Set rtitem = doc.GetFirstItem( "attach" )  '  поле Вложения
    If rtitem Is Nothing Then Exit Sub
    If Isempty( rtitem.EmbeddedObjects ) Then Exit Sub
    Print "Поле Вложения attach  Есть"
    y=0
    varAttachmentNames = "" 
    Forall x In rtitem.EmbeddedObjects ' пробегаемся по атачментам в поле attach
        If Len( varAttachmentNames ) > 0 Then varAttachmentNames = varAttachmentNames +Chr(10) 
        varAttachmentNames = varAttachmentNames + x.Name
        y=y+1    
    End Forall
    If Len( varAttachmentNames ) = 0 Then Exit Sub
    
    Let strTempPath = Environ$("TEMP") ' путь во временную папку
    Let strTempPath = "C:\LotusDoc"
    
    varAttachmentNames = Split( varAttachmentNames, Chr(10) ) ' список всех имен атачментов
    
    vPrompt =  varAttachmentNames(0) '  первый аттач (он на винте)
    ' надо, если много аттачей - то выбрать
    If y>1 Then
        vPrompt = ws.Prompt( 4, "Выберите вложение", "Прикрепленные документы:", varAttachmentNames(0), varAttachmentNames ) 
    End If
    If Isempty(vPrompt) Then Exit Sub
    Print " Вложение" Cstr(vPrompt) 
    
    fname = Cstr(vPrompt) 
    sdate = Evaluate("@Now( [ServerTime])")
    mes = sdate(0)
    mes=Replace(mes, ":","-" )
    mes = mes+" "+fname  '  имя файла на винте
    
    Set vFile = rtitem.GetEmbeddedObject(vPrompt)
    Call vFile.ExtractFile(strTempPath + "\" + vPrompt) ' скидываем файл на диск  - заменяет если файл с таким именем уже есть в папке
    
    Call vFile.ExtractFile(strTempPath + "\" + mes) ' скидываем изначальный файл на диск
    Print "mes1_strTempPath:" strTempPath + "\"  & mes
    Call vFile.Remove 'удаляем аттачмент с лотус дока
    Call rtitem.Update
    
    Set WShell = CreateObject("WScript.Shell") 
'    ReturnCode = WShell.run("""" +strTempPath + "\" + vPrompt+"""", 1, True) ' проблема, если запущен word, то ошибка (On Error Goto er)
    WShell.run("""" +strTempPath + "\" + vPrompt+"""") 
    Messagebox "Перед продолжением обязательно закройте открытые файлы в Word!", ok,   "Внимание!"
           
    
    Call rtitem.EmbedObject( EMBED_ATTACHMENT, "",strTempPath + "\" + vPrompt , "" ) ' добаляем файл обратно в аттач
    Kill strTempPath + "\" + vPrompt ' удаляем на локале измененный файл
    Call rtitem.Update
    
' копируем на винт еще и измененный файл 
    sdate = Evaluate("@Now( [ServerTime])")
    mes = sdate(0)
    mes=Replace(mes, ":","-" )
    mes = mes+" "+fname
    Print "mes2_strTempPath:" strTempPath + "\"  & mes
    Set vFile = rtitem.GetEmbeddedObject(vPrompt)   ' аттач
    Call vFile.ExtractFile(strTempPath + "\" + mes) 
    
    Call doc.Save(True,False)
    Call uidoc.Save
    Exit Sub
    
er: 
    Messagebox "Ошибка, изменения не сохранены в файле "+vPrompt, ok,   "Внимание!"
    Resume Next
    mes=Err
    
End Sub