1 Тема от admin

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

Тема: Проверка в документах целостность вложения при вкл. DAOS

При включенном DAOS в базе, у части документов битые вложения.
Были удалены файлы nlo с папочки DAOSа.
Вот код, который проходится по аттачам документа, сохраняя из на винт.
Если не получается сохранить вложение - документ помечаем.

Проверить вложения у всех доков во ВЬЮ.

Sub Click(Source As Button)
    Dim session As New NotesSession    
    Dim db As NotesDatabase, workdb As NotesDatabase
    Dim view As NotesView
    Dim doc As NotesDocument, newdoc As NotesDocument
    Dim server As String
    '
    Dim dc As NotesDocumentCollection
    Dim ftdoc As notesdocument
    Dim  tmpdoc As  NotesDocument
    
    Dim item As NotesItem
    Dim rtitem As NotesRichTextItem
    Dim b As Boolean
    
    On Error Goto Errh
    Set db = session.CurrentDatabase
    server = db.Server
    Set view=db.GetView("aaa_2015")
    
    Dim i As Integer
    i=1
    Set doc = view.GetFirstDocument
    While Not (doc Is Nothing)
        Print i & ".  " & doc.regnom_1(0) & "  от   "   &  Cstr( doc.datereg(0))
        Set tmpdoc = doc 
        If     doc.HasItem("attach") Then
            Set rtitem = 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   
                            Print obj.Source
                            Call obj.ExtractFile( "C:\XML" & obj.Source )   ' тоже фиг обработаешь ((
                            Print "ok"
                            Kill   "C:\XML" & obj.Source 
nextobj:
                        End If
                    End Forall
                End If
            End If
        End If
        
        i=i+1
        Set dc = doc.Responses    
        Set ftdoc = dc.GetFirstDocument    
        Set tmpdoc = doc 
        While Not ftdoc Is Nothing
            b=ftdoc.Hasitem("header")
            If b Then b=ftdoc.header(0)<>""    
            If Not b Then
                Print "ОКУРОК???. форма "     ftdoc.Form(0)  " дата "       ftdoc.Created  " id " ftdoc.UniversalID
                If ftdoc.IsValid =False Or ftdoc.IsDeleted = True Then 
                    Print "ТОЧНА ОКУРОК!!!"
                Else 
                ' ПРОВЕРИТЬ ВЛОЖЕНИЯ ОТВЕТОВ    
                End If
            End If
            Set ftdoc = dc.GetNextDocument (ftdoc )    
        Wend    ' Responses
        Set doc = view.getnextdocument(doc)
    Wend
    Exit Sub
Errh:    
    Print Error & | in line | & Erl() "   ---   "  Err
    
    If Err = 4005 Then
        Print "битое вложение"
        tmpdoc.empty="1"
        Call tmpdoc.Save(True,False)
        Resume nextobj
    End If
    
    Exit Sub
End Sub

Поделиться