1 Тема от admin

  • admin
  • admin
  • Administrator
  • Неактивен
  • Зарегистрирован: 2010-04-07
  • Сообщений: 1,270
  • Репутация : 0

Тема: Сортировка приложений в rich text поле. Удаление и прикрепление.

Удаление и прикрепление приложений в LotusScript .
Сделано при вычисляемом (нередактируемом) rich text  поле "attach".
Чтобы юзеры без прав не могли удалять вложения.

Кнопка "Прикрепить"


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
    Dim picklist As Variant, mes As String
    Dim rtitem As NotesRichTextItem
   
    Set doc = ws.CurrentDocument.Document
    Set uidoc=ws.CurrentDocument
    Set rtitem = doc.GetFirstItem("attach")
    filenames = ws.OpenFileDialog(     True, "Select file")
   
    If Not(Isempty(filenames)) Then
        Forall filename In filenames
            Print  filename
            Call rtitem.EmbedObject ( EMBED_ATTACHMENT, "", filename)
        End Forall
        Call rtitem.Update
       
        doc.ReplaceItemValue({SaveOptions},{0}).SaveToDisk=False
        Call doc.save (True,False)       
        Call uidoc.Close
        Call ws.EditDocument(True, doc)
       
    End If
    Exit Sub
   
ErrH:
    Print "Ошибка " & Error(Err) & " в строке " & Erl   
    Exit Sub
End Sub

Поделиться

2 Ответ от admin

  • admin
  • admin
  • Administrator
  • Неактивен
  • Зарегистрирован: 2010-04-07
  • Сообщений: 1,270
  • Репутация : 0

Re: Сортировка приложений в rich text поле. Удаление и прикрепление.

Кнопка "Удалить" - после удаления выбранного вложения создает документ с удаленным сложением в базе корзина.


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  ' все имена вложений
   
    Set doc = ws.CurrentDocument.Document
    Set uidoc=ws.CurrentDocument
    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 ' в Name_Stncl_List вносим имена вложений
                        Print Name_Stncl_List(i)
                        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   
        flag = ws.DialogBox("ChooseDlg",True,True,False,False,False,False,"Выберите документы для удаленияl",doctemp, True)
        If flag=False Then    Exit Sub
    End If
    q$=""
    k = Ubound(doctemp.ListAttach)  ' поле ListAttach с именами вложений на форме ChooseDlg
    If k = 0 And doctemp.ListAttach(0) = "" Then Messagebox "Не выбраны  приложения", 64, "Внимание"   
    For jj = 0 To k
        q$=doctemp.ListAttach(jj)
        Print q$
        Forall obj In rtitem.EmbeddedObjects
            If obj.Source  =q$ Then
                Print  "удалить " obj.Source
                ' Копирование в КОРЗИНУ
                Set db = session.CurrentDatabase
               
                server$ = db.Server
                databaseFileName$  = "promdoc\recycled.nsf"
                Print  server$ "\"  databaseFileName$
                Set db = session.GetDatabase(server$, databaseFileName$)
                If Not db.Isopen Then
                    Messagebox    "Нет доступа к Базе Корзина!", 16, "Ошибка!!!"   
                    Exit Sub
                End If
               
                datapatch$ = "C:\XML\"
                If  Dir$ (datapatch$ ,16 )="" Then
                    Mkdir datapatch$
                End If
                Call obj.ExtractFile( datapatch$ & obj.Source )
               
               
               
                Dim docR As NotesDocument
                Set docR = db.GetDocumentByUNID(doc.id(0))
                Print "doc.id " doc.id(0)
                Dim flagr As Boolean
                flagr=False
                If docR Is Nothing Then
                    flagr=True
                Else
                    Print "docR.UniversalID   "  docR.UniversalID
                    If docR.Size>0 Then
                        Print "Док уже есть.Крепим удаленное вложение"
                        Set rtitem2 =  docR.GetFirstItem("attach" )
                    Else
                        Print "НУЛЕВОЙ ГЛЮЧНЫЙ ДОК!"
                        If docR.IsDeleted Then Print "DELETED"
                        flagr=True 
                    End If
                End If
               
               
                If flagr=True Then
                    Print "Создать док"
                    Set docR = New NotesDocument( db ) '   '               ----------  новый   Док в базе Корзина   
                    Set rtitem2 = New NotesRichTextItem (docR,"attach")
                    docR.form = doc.form
                    docR.header = doc.header
                    docR.adresed = doc.adresed
                    docR.datereg = doc.datereg
                    docR.isp = doc.isp
                    docR.regnom_1   = doc.regnom_1       
                    docR.regnom  = doc.regnom     
                    docR.doctype = doc.doctype
                    docR.docnomen = doc.docnomen
                    docR.date_kor = doc.date_kor
                    docR.regnom_kor = doc.regnom_kor
                    docR.history = doc.history
                    docR.id = doc.id
                    docR.fullregnom = doc.fullregnom
                    docR.isreg = doc.isreg
                    docR.archive = doc.archive
                    docR.UniversalID=doc.UniversalID
                End If
               
                Call rtitem2.EmbedObject ( EMBED_ATTACHMENT, "", datapatch$ & obj.Source)
                Call    docR.Save(1,0)
                Print "СОхранили."
               
                doc.history= Cstr(Now)      + " "+  session.CommonUserName + " удалено приложение ("  + obj.Source + ") "   &Chr(13) & " "&Chr(13) &  doc.history(0)
                Call  obj.Remove
            End If
        End Forall
    Next
   
    '        Call rtitem.Update
    doc.ReplaceItemValue({SaveOptions},{0}).SaveToDisk=False
    Call doc.save (True,False)
    Call uidoc.Close
    Call ws.EditDocument(True, doc)  '  False - чтение
   
   
    Exit Sub
   
ErrH:
    If Err = 4091 Then
        Print "Документа нет в Корзине!"
        Resume Next
    End If
    Print "Ошибка " & Error(Err) & " в строке " & Erl   
    Exit Sub
End Sub

Поделиться

3 Ответ от admin

  • admin
  • admin
  • Administrator
  • Неактивен
  • Зарегистрирован: 2010-04-07
  • Сообщений: 1,270
  • Репутация : 0

Re: Сортировка приложений в rich text поле. Удаление и прикрепление.

сортировка приложений в не редактируемом поле.
1.отсортировать в формочке массив имен.
2.выгурзить вложения на винт.
3.удалить и прикрепить уже в порядке - как на формочке.

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  ' все имена вложений
    Dim Field As NotesItem
   
    Set doc = ws.CurrentDocument.Document
    Set uidoc=ws.CurrentDocument
    Set rtitem = doc.GetFirstItem("attach")
   
    Dim xxxx As  Integer
   
    Set DocTemp = doc.ParentDatabase.CreateDocument
    DocTemp.name_fields="attach"  'передаем список нужных полей для сортировки
    DocTemp.sort=""
    Set Field = DocTemp.GetFirstItem("sort")     
    Set itemA = doc.GetFirstItem("attach"   )
   
    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
                    End If           
                   
                    Call  Field.AppendToTextList(obj.Source )  ' имя приложения в поел sort
                   
                End If
            End Forall
        End If
    End If   
   
    DocTemp.sort=Fulltrim(DocTemp.sort)
   
    Call itemA.CopyItemToDocument( DocTemp, "attach"   )           
    flag = ws.Dialogbox("sort2",True,True,,,,,"",doctemp,,)       
    If Not flag Then    Exit Sub   
   
    Print "выгрузили вложения на винт"
    Forall obj In rtitem.EmbeddedObjects
        Call    obj.ExtractFile( "C:\XML\" & obj.Source )
        Call  obj.Remove
    End Forall
    Call rtitem.Update
    Print "крепим отсортированно"
    Forall v In DocTemp.sort
        Print v
        Call rtitem.EmbedObject ( EMBED_ATTACHMENT, "",  "C:\XML\" & v)
    End Forall
   
    doc.ReplaceItemValue({SaveOptions},{0}).SaveToDisk=False
    Call doc.save (True,False)
    Call uidoc.Close
    Call ws.EditDocument(True, doc)  '  False - чтение
   
    Exit Sub
   
ErrH:
    If Err = 4091 Then
        Print "Документа нет в Корзине!"
        Resume Next
    End If
    Print "Ошибка " & Error(Err) & " в строке " & Erl   
    Exit Sub
End Sub

Поделиться

4 Ответ от admin

  • admin
  • admin
  • Administrator
  • Неактивен
  • Зарегистрирован: 2010-04-07
  • Сообщений: 1,270
  • Репутация : 0

Re: Сортировка приложений в rich text поле. Удаление и прикрепление.

Форма sort2.
СОдержит поля
sort - массив имен полей, sortName - сортируемые имена - листбокс.
стреочки
вверх    Call sort(True)
вниз    Call sort(False)

Функция в глобалс

Sub sort(flag As Boolean)'flag=true - вверх, flag=false - вниз
    Print    "sort"
    On Error Goto ErrH
    Dim session As New NotesSession, ws As New NotesUIWorkspace, db As NotesDatabase, uidoc As NotesUIDocument
    Dim doc As NotesDocument, dc As NotesDocumentCollection, item As NotesItem
    Dim rtitem As NotesRichTextItem
    Dim array_s() As arrays, arrs As Variant
   
    Set db = session.CurrentDatabase   
    Set uidoc = ws.CurrentDocument
    Set doc = uidoc.Document
    Set rtitem = doc.GetFirstItem("attach")
   
    If doc.sortName(0)<>"" Then       
        arr=doc.sort       
        i=Arraygetindex(arr,doc.sortName(0))
        Print "выделенный док i=" i
        If (flag And i<>0) Or (Not flag And i<>Ubound(arr)) Then
            If flag Then i1=i-1 Else i1=i+1
           
            t=arr(i1)
            arr(i1)=arr(i)               
            arr(i)=t           
            Print "arr(i) = "  arr(i)
           
            doc.sort=arr           
           
            Call uidoc.Refresh           
        End If
    End If   
   
    Print "arr"
    For xxx = 0 To Ubound(arr)
        Print     arr(xxx)
    Next   
   
    Exit Sub
   
ErrH:
   
    Print "Ошибка sort " & Error(Err) & " в строке " & Erl   
    Exit Sub
End Sub

Поделиться