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

[StarikStarik2705]

добрый день, есть задача выгрузка документов из представления на диск с сохранением иерархии документов. грубо говоря если есть док у него дети и там ещё по паре детей то будет дерево документов, и мне такое же дерево нужно из папок создать на основе иерархии документов, настрочил такую штуку
%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

 

[Serduko]

А где указан корневой каталог, как программа возвращается к нему?

 

[StarikStarik2705]

А где указан корневой каталог, как программа возвращается к нему?

я прошу прощения я так разволновался что ничего сделать не могу что всё сделал) вот код может пригодиться
%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