Решено Выгрузка всех файлов из базы..

[JohnLemon]

Здравствуйте, необходимо выгрузить все файлы в папки с ID доком пытаюсь делать так:

Sub Click(Source As Button)
Dim session As NotesSession
Set session = New NotesSession
Set db = session.CurrentDatabase
Set col = db.AllDocuments
Set col1 = db.GetView("default")
 
If col.Count <> 0 Then
Set doc = col.GetFirstDocument
Do While Not( doc Is Nothing )
Set rtitem = doc.GetFirstItem( "Body" )
If (rtItem.Type = RICHTEXT) Then
Forall o In rtitem.EmbeddedObjects
fileCount = fileCount + 1
If (o.Type = EMBED_ATTACHMENT) Then Call o.ExtractFile("c:\temp\" & o.Name)
End Forall
End If
Call session.UpdateProcessedDoc( doc )
Set doc = col.GetNextDocument(doc)
Loop
End If
End Sub

Выгружается 96 файлов а дальше ошибка "Несоответствие типов в методе ForAllInit: найдено FROMVAR, ожидался Unknown" В чем может быть проблема не пойму?

 

[garrick]

Битый документ попался. Попробуй найти его и открыть в клиенте, наверняка выскочит какая-то ошибка, типа "32К".

 

[JohnLemon]

Битый документ попался. Попробуй найти его и открыть в клиенте, наверняка выскочит какая-то ошибка, типа "32К".

как можно исключить такие доки ? ) И как найти его )

 

[lmike]

возможно - через ДХЛ

 

[alexas1]

как можно исключить такие доки ? ) И как найти его )

Если у тебя вьюшка сортирована то:
в цикле While принтуй номер итерации.
После ошибки, номер геморойного дока будет последний принтованный номер +1.

как можно исключить такие доки

On Error Resume Next пропустит все ошибки и не прервёт цикл... Также, можешь нормально обработать ошибку и в обработчике сохранить в список unids геморойных доков. Потом с ними врукопашную разберёшься.
ЗЫ
лучче даже, не сохранять юниды, а сразу слать весь гемор в какой нить фолдер, там и грести.

 

[Shandrik]

Также стоит позаботится об одноименных файлах. Лучше выгружать в подпапку, именованную UNID-ом, и учитите, что если попадутся одноименные в одном документе, то название при выгрузке у них будет неожиданное.

 

[JohnLemon]

Лучше выгружать в подпапку, именованную UNID-ом

Я так и планировал сделать...
Вот сделал в роде обработку ошибок, 1 обрабатывается, а если вторая то останавливается скрипт. Проблема скорее всего что вообще нету атачей в доке!

Sub Click(Source As Button)
 

Dim session As NotesSession
Set session = New NotesSession
Set db = session.CurrentDatabase
Set view = db.GetView("all")
Set doc = view.GetFirstDocument
l = 0
lblNorm:
While Not(doc Is Nothing)
On Error Goto lblErrs
l = l +1
Print(l)
Set rtitem = doc.GetFirstItem( "Body" )
If (rtItem.Type = RICHTEXT) Then
Forall o In rtitem.EmbeddedObjects
If (o.Type = EMBED_ATTACHMENT) Then Call o.ExtractFile("c:\temp\" & o.Name)
End Forall
End If
Set doc = view.GetNextDocument(doc)
Wend
Exit Sub
lblErrs:
Messagebox "Error "
Set doc = view.GetNextDocument(doc)
Goto lblNorm
Exit Sub
End Sub

 

[savl]

Не проверял, но попробуйте:

Код

Sub Click(Source As Button)
On Error Goto Handler
 dim ErrStr as String
 Dim session As  New NotesSession
 Set db = session.CurrentDatabase
 Set view = db.GetView("all")
 view.autoupdate = false
 Set doc = view.GetFirstDocument
 
While Not(doc Is Nothing)
Set rtitem = doc.GetFirstItem( "Body" )
If (rtItem.Type = RICHTEXT) Then
Forall o In rtitem.EmbeddedObjects
If (o.Type = EMBED_ATTACHMENT) Then 
Call o.ExtractFile("c:\temp\" & o.Name)
end if
End Forall
End If
nextDoc:
Set doc = view.GetNextDocument(doc)
Wend
 
view.autoupdate = True
 
Exit Sub
 
Handler:
ErrStr = {Error: } & Error$ & { in line } & erl
if not doc is nothing then ErrStr = ErrStr & chr(10) & doc.universalId
if session.IsOnServer then 
Print ErrStr
else
msgbox ErrStr, 16
end if
if not doc is nothing then resume nextDOc
if not view is nothing then view.autoupdate = True
Exit Sub
End Sub

 

[Shandrik]

После 11-й строки проверьте rt-item на Nothing

 

[lmike]

положили выборку на диск, в виде ДХЛ, натравили LAX - всё!

 

[Shandrik]

Мне не надо, чтобы хорошо, мне надо, чтобы ты ... (с)

 

[Shandrik]

Если надо выгрузить все файлы из документов, то может стоит получать EmbeddedObjects не от определенного айтема, а прямо от НотесДокумента?

 

[garrick]

положили выборку на диск, в виде ДХЛ, натравили LAX - всё!

Если ошибка про 32К, то выгрузка DXL по-моему тоже должна "споткнуться" об такой документ. Любая попытка чтения полей такого документа генерит ошибку. Надо строить обход таких документов через On Error Goto...

Set doc = view.GetFirstDocument
On Error Goto NextDoc
if doc.HasEmbedded then
	 .....
end if
NextDoc:
Set doc = view.GetNextDocument(doc)

 

[JohnLemon]

положили выборку на диск, в виде ДХЛ, натравили LAX - всё!

LAX не в курсе даже что такое

Мне не надо, чтобы хорошо, мне надо, чтобы ты ... (с)

Я не прошу делать за меня я прошу указать на ошибки, форумы ведь для этого, а не для самоудовлетворения типо "Я такой крутой!"

может стоит получать EmbeddedObjects не от определенного айтема, а прямо от НотесДокумента

есть ссылка или пример ?
Сделал так:

Sub Click(Source As Button)
On Error Goto Handler
Dim ErrStr As String
Dim session As  New NotesSession
Set db = session.CurrentDatabase
Set view = db.GetView("all")
view.autoupdate = False
Set doc = view.GetFirstDocument
While Not(doc Is Nothing)
Set rtitem = doc.GetFirstItem( "Body" )
If (rtItem.Type = RICHTEXT) Then
Forall o In rtitem.EmbeddedObjects
If (o.Type = EMBED_ATTACHMENT) Then
Mkdir "d:\TEMP\" & doc.universalId & "\"
Call o.ExtractFile("C:\Temp\" & o.Name)
End If
End Forall
End If
nextDoc:
Set doc = view.GetNextDocument(doc)
Wend
 
view.autoupdate = True
 
Exit Sub
 
Handler:
ErrStr = {Error: } & Error$ & { in line } & Erl
If Not doc Is Nothing Then ErrStr = ErrStr & Chr(10) & doc.universalId
If session.IsOnServer Then
Print ErrStr
Else
Mkdir "c:\TEMP\" & doc.universalId & "-problem\"
End If
If Not doc Is Nothing Then Resume nextDOc
If Not view Is Nothing Then view.autoupdate = True
Exit Sub
End Sub

На первый взгляд в роде работает правильно все, но почему то создаются папки с правами, что я не могу потом ничего записать в них (

 

[Shandrik]

Mkdir "d:\TEMP\" & doc.universalId & "\"
Call o.ExtractFile("C:\Temp\" & o.Name)

Вы ничего не забыли/не перепутали?
Не тот это город и полночь не та... (с)

 

[JohnLemon]

Mkdir "d:\TEMP\" & doc.universalId & "\"
Call o.ExtractFile("C:\Temp\" & o.Name)
Вы ничего не забыли/не перепутали?
Не тот это город и полночь не та... (с)

Да это я проверял просто как папки создаются. Во первых почему то только для чтения. потом установил для папки темп на диске д доступ всем - полный доступ, но ни создаются почему то для всех - особые права, и записать я в них ничего не могу (

 

[Shandrik]

Пишите не в C/D:\Temp, а в папку, полученную из Environ("Temp")
[DOUBLEPOST=1434618580,1434618345][/DOUBLEPOST]У Вас поля Body может и не быть, и код свалится при обращении к нафинг-айтему.
Если задача выгрузить все файлы из всех документов, то
EmbeddedObjects получайте из самого документа:

While Not(doc Is Nothing)
Set rtitem = doc.GetFirstItem( "Body" )
If (rtItem.Type = RICHTEXT) Then
Forall o In doc.EmbeddedObjects
...

 

[Мыш]

@Shandrik, насколько мне помнится, были какие-то засады с doc.EmbeddedObjects - то ли не все файлы извлекались, то ли ошибка выпадала. ИМХО, через RichTextItem правильней...Да, нужно проверять наличие айтема и его тип.

Set rtitem = Nothing
Set rtitem = doc.GetFirstItem( "Body" )
If not rtitem Is Nothing Then
	If ( rtitem.Type = RICHTEXT ) Then 
		If Not Isempty(rtitem.EmbeddedObjects) Then   
			Forall o In rtitem.EmbeddedObjects	  ...

@JohnLemon, Domino как сервис работает? Если да, то под каким пользователем?

 

[lmike]

Если ошибка про 32К, то выгрузка DXL по-моему тоже должна "споткнуться" об такой документ.

не уверен, яж не буду перебирать документы..., но надо тестить
а выгрузка примечательна тем, что обработка возможна массово и без нотусевых классов
Call notesXMLProcessor.SetInput(NotesDocumentCollection)

LAX не в курсе даже что такое

а поискать на форуме?

 

[lmike]

мало того - возможно, для доков с картинками - не выгружать в поток картинки (опция)