Выгрузка Документов Из Представления На Диск

Тема в разделе "Lotus - Программирование", создана пользователем StarikStarik2705, 15 апр 2013.

  1. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    добрый день, есть задача выгрузка документов из представления на диск с сохранением иерархии документов. грубо говоря если есть док у него дети и там ещё по паре детей то будет дерево документов, и мне такое же дерево нужно из папок создать на основе иерархии документов, настрочил такую штуку
    %REM
    Function DownloadForHDD
    Description: Comments for Function
    %END REM
    Function DownloadForHDD(pardoc As NotesDocument, path As String)
    'функция для выгрузки документов и их содерждимого(файлов если есть), с сохранением папок, на жёсткий диск
    On Error GoTo errsub
    Dim s As New NotesSession
    Dim db As NotesDatabase
    Dim cancelReason As String
    Dim tmpdoc As NotesDocument
    Dim dc As NotesDocumentCollection
    Dim respdoc As NotesDocument
    Set db = s.CurrentDatabase
    If Not pardoc Is Nothing Then
    If pardoc.getitemvalue( "Form" )( 0 ) = "Folder" Then
    path = path & "\" & pardoc.getitemvalue( "FolderName" )( 0 )
    print path + " - Folder"
    MkDir path
    ' создать папку path
    Else ' это карточка пд
    Print "CardPD"
    ' тут вызвать функцию выгрузки вложений, которую я еще не написал
    End If
    Set dc = pardoc.responses
    Set respdoc = dc.getfirstdocument
    While Not respdoc Is Nothing
    Set tmpdoc = dc.Getnextdocument( respdoc)
    Call DownloadForHDD( respdoc, path )
    Set respdoc = tmpdoc
    Wend

    Else
    MsgBox "Не выделена карточка.",16,"Сообщение"
    Exit function
    End If
    endsub:
    Exit Function
    errsub:
    MsgBox " ошибка на строке.. >> Error " & Error & " on " & Erl
    Resume endsub

    но она просто лезет внутрь уже созданого каталога и там создаёт папку, до тех пор пока есть документы, кто то сталкивался с такой задачей? и как её правильно решить?



    End Function
     
  2. Serduko

    Serduko Well-Known Member

    Регистрация:
    11 окт 2011
    Сообщения:
    174
    Симпатии:
    0
    А где указан корневой каталог, как программа возвращается к нему?
     
  3. StarikStarik2705

    StarikStarik2705 Well-Known Member

    Регистрация:
    8 фев 2012
    Сообщения:
    103
    Симпатии:
    0
    я прошу прощения я так разволновался что ничего сделать не могу что всё сделал) вот код может пригодиться
    %REM
    Function DownloadForHDD
    Description: Comments for Function
    %END REM
    Function DownloadForHDD(pardoc As NotesDocument, path As String)
    'функция для выгрузки документов и их содерждимого(файлов если есть), с сохранением папок, на жёсткий диск
    On Error GoTo errsub
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject") 'инструмент для работы с папками и файлами
    If FSO Is Nothing Then
    Print {Не удалось создать OLE объект}
    Exit Function
    End If

    Dim s As New NotesSession
    Dim db As NotesDatabase
    Dim cancelReason As String
    Dim newPath As String
    Dim dc As NotesDocumentCollection
    Dim respdoc As NotesDocument
    Set db = s.CurrentDatabase
    If Not pardoc Is Nothing Then
    If CanEditDoc( pardoc, cancelReason ) Then
    Set dc = pardoc.Responses
    Set respdoc = dc.Getfirstdocument()
    While Not respdoc Is Nothing
    If respdoc.getitemvalue("Form") ( 0 ) = "CardPD" Then
    MsgBox path & " - file "
    'Print "CardPD"
    ElseIf respdoc.getitemvalue("Form") ( 0 ) = "Requirement" Then

    ' Print "Requirement"
    ElseIf respdoc.getitemvalue("Form") ( 0 ) = "TaxPackage" Then

    ' Print "TaxPackage"
    elseIf respdoc.getitemvalue("Form") ( 0 ) = "Folder" Then
    newPath = path & "\" & respdoc.getitemvalue( "FolderName" )( 0 )
    if not FSO.FolderExists(newpath) Then ' исключает возможность создания папки если такая уже есть в каталоге
    Print "Создаёться папка: " & newPath
    Call FSO.CreateFolder(newPath)
    Call DownloadForHDD( respdoc, newPath )
    Else
    Call DownloadForHDD( respdoc, newPath )
    Print "папка с именем - " & getFolderName(newPath) & " уже существует"
    End If
    End If
    Set respdoc = dc.Getnextdocument(respdoc)
    Wend
    ElseIf Len( cancelReason ) > 0 Then
    MsgBox "Действие выполнить нельзя: " & cancelReason, 48, "Ошибка"
    End If
    Else
    MsgBox "Не выделена карточка.",16,"Сообщение"
    Exit function
    End If
    endsub:
    Exit Function
    errsub:
    MsgBox " ошибка на строке.. >> Error " & Error & " on " & Erl
    Resume endsub





    End Function
     
Загрузка...

Поделиться этой страницей