1 Тема от admin

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

Тема: Выгрузка вложений с текущего вида у выбранных документов.

Данный лотус-скрипт выгружает все вложения с документов в папку c:\XML
Скрываем кнопку для всех, кроме админа.

@IsNotMember("[admin]";@UserRoles)

Код кнопочки

Sub Click(Source As Button)
    On Error Goto ErrH
    Dim ws As New NotesUIWorkspace
    Dim view As NotesUIView
    Dim dc As notesdocumentcollection
    Dim doc As NotesDocument
    Dim rtitem As NotesRichTextItem
    Dim vFile As NotesEmbeddedObject
    
    Set view=ws.CurrentView
    Set dc=view.Documents
    Set doc=dc.GetFirstDocument
    While Not doc Is Nothing
        
        Set rtitem = doc.GetFirstItem( "XMLattach" )
        Print "ИСХ"
        If Not rtitem Is Nothing   Then 
            If   Not Isempty( rtitem.EmbeddedObjects )  Then
                Forall x In rtitem.EmbeddedObjects 
                    Set vFile = rtitem.GetEmbeddedObject(x.Name)
                    Call vFile.ExtractFile("c:\\\XML\\" + vFile.Name)       
                End Forall
            End If
        End If
        
        Set rtitem = doc.GetFirstItem( "attach" )  
        Print "ВХ"
        If Not rtitem Is Nothing   Then 
            If   Not Isempty( rtitem.EmbeddedObjects )  Then
                Forall x In rtitem.EmbeddedObjects 
                    Set vFile = rtitem.GetEmbeddedObject(x.Name)
                    Call vFile.ExtractFile("c:\\\XML\\" + vFile.Name)       
                End Forall
            End If
        End If
        
        Set doc=dc.GetNextDocument(doc)
    Wend
    
    Exit Sub
ErrH:
    Print "Ошибка: " & Error(Err) & " в строке " & Erl
    Exit Sub
End Sub

Поделиться