Тема: Работа с MIME в Lotus
Есть у меня кнопка для переименования вложений, которая дергает мою функцию GetEmbedObject - в которой я хочу переименовать вложение с помощью NotesMIMEEntity.
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 Name_Stncl_List() ' все имена вложений
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 GetEmbedObject ("attach", datapatch$ & new_nameobj, doc )
' Msgbox object.Name
' Call object.Remove
Kill datapatch$ & new_nameobj
End If
End If
i=i+1
End Forall
Call doc.ComputeWithForm(False, False)
Call doc.Save(1,0)
Call uidoc.save
Print "11."
' Set rtitem = doc.GetFirstItem("attach")
' Forall obj In rtitem.EmbeddedObjects
' Print object.Source
' For i = 1 To Len(object.Source)
' ch = Mid$(object3.Source, i, 1)
' Print "Символ=" & ch & ", Код(Asc)=" & Asc(ch)
' Next
' End Forall
Print "Сохранили."
' doc.history= Cstr(Now) + " "+ session.CommonUserName + " переименовано приложение (" + 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