Войти
 
 
 
Форум NotesNet Регистрация Список пользователей Последние сообщения Поиск Выход
Форум NotesNet > Разработка notes-приложений > выгрузка документов из lotus notes в excel
   
Для создания сообщения необходимо
аутентифицироваться на сервере
03/17/2014 04:20:00 PM выгрузка документов из lotus notes в excel
Daniil
Регистрация: 07/12/2011
Сообщений: 4
Добрый день! Столкнулся со следующей задачей, есть скрипт агента...агент выгружает в excel полностью все представление документа...и нужное (номер зарегистрированного документа, дату и т.д.), и не нужное (Form, $WebFlags и т.д.) пользователям эта информация определенна не нужна...вот все никак не могу додумать какой кусок кода должен быть чтобы он выбирал только то что мне нужно, в написании агентов я не очень силен...ниже приведу пример


Sub Initialize
Dim ws As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As NotesDatabase
Dim docColl As NotesDocumentCollection
Dim xlDoc As NotesDocument
Dim xlApp As Variant
Dim xlWorkBook As Variant
Dim xlWorksheet As Variant
Dim xlVersion As Variant
Dim xlVersionInt As Integer
Dim xlPath As Variant
Dim xlRowCount As Integer
Dim xlSheetCount As Integer
Dim xlSheetName As String
Dim ArrCount As Integer
Dim ItemArray As Variant

Set db = session.CurrentDatabase
Set docColl = ws.CurrentView.Documents

'Отмечены ли документы?
If docColl.Count = 0 Then
MsgBox "Не выбран документ"
Exit Sub
End If

'создаем объект Excel
Set xlApp = CreateObject("Excel.Application")
'определяем версию Excel
xlVersion = Split(xlApp.Application.Version, ".")
xlVersionInt = xlVersion(0)
'Показываем Excel
xlApp.visible = True
'Добавляем книгу
xlApp.Workbooks.Add
Set xlWorkbook = xlApp.Workbooks(1)
'Создаем листы по количеству выделенных документов
xlWorkbook.Worksheets(1).Copy(xlWorkbook.Worksheets(1))

xlSheetCount = 1 'начинаем с первого листа
Set xlDoc = docColl.GetFirstDocument 'берем первый документ из коллеции

'До тех пор, пока не кончатся выбранные документы
Do While Not(xlDoc Is Nothing)
Set xlWorksheet = xlWorkbook.Worksheets(xlSheetCount) 'выбираем лист
With xlWorksheet 'работаем с листом
xlWorksheet.Activate 'Активируем лист
'присваиваем имя Листу
xlSheetName = "(" & CStr(xlSheetCount) & ") " & Left(xlDoc.Shop(0), 23) & "..."
xlApp.ActiveSheet.Name = xlSheetName
'печатаем заголовки столбцов
xlRowCount = 1
.Cells(xlRowCount, 1)= "FieldName"
.Cells(xlRowCount, 2)= "FieldType"
.Cells(xlRowCount, 3)= "FieldValue"
xlRowCount = 2
'Бежим по всем items документа
ForAll item In xlDoc.Items
If Not (item.Type = 1) Then 'если не rtitem
ArrCount=0
ItemArray = item.Values
'Если длина массива не равна 0
If UBound(ItemArray)<>0 Then
'Выгружаем все элементы массива
ForAll v In item.Values
.Cells(xlRowCount, 1)= item.Name & "(" & CStr(ArrCount) & ")"
.Cells(xlRowCount, 2)= item.type
.Cells(xlRowCount, 3)= item.Values(ArrCount)
xlRowCount = xlRowCount+1
ArrCount=ArrCount+1
End ForAll
Else 'выгружаем значение item
.Cells(xlRowCount, 1)= item.Name
.Cells(xlRowCount, 2)= item.type
.Cells(xlRowCount, 3)= item.Values(0)
xlRowCount = xlRowCount+1
End If
Else 'выгружаем значение rtitem
.Cells(xlRowCount, 1)= item.Name
.Cells(xlRowCount, 2)= item.type
.Cells(xlRowCount, 3)= item.Values
xlRowCount = xlRowCount+1
End If
End ForAll
'автовыравнивание по ширине
xlApp.ActiveSheet.Columns.AutoFit
End With
'переходим к следующему листу
xlSheetCount = xlSheetCount+1
'переходим к следующему документу в коллекции
Set xlDoc = docColl.GetNextDocument(xlDoc)
Loop
'указываем путь и имя файла для сохранения
xlPath = ws.SaveFileDialog(False, "Введите название для файла выгрузки", "Excel|*.xls", ,"DocFieldsExport.xls")

If IsEmpty(xlPath) Then Exit Sub

If 6 = MsgBox("Открыть созданный файл ?", 36,"DocFieldsExport to Excel") Then
If xlVersionInt < 9 Then Exit Sub
If xlVersionInt < 12 Then
Call xlWorkbook.SaveAs(xlPath(0))
xlApp.visible = True
Else
Call xlWorkbook.SaveAs(xlPath(0), 56)
xlApp.visible = True
End If
Else
If xlVersionInt < 9 Then Exit Sub
If xlVersionInt < 12 Then
Call xlWorkbook.SaveAs(xlPath(0))
Call xlWorkbook.Close(True)
xlApp=""
Else
Call xlWorkbook.SaveAs(xlPath(0), 56)
Call xlWorkbook.Close(True)
xlApp=""
End If
End If
'Снимаем галочки в представлении
Call ws.CurrentView.DeselectAll
End Sub

 
Ответить с цитированием
03/21/2014 10:22:32 AM
Ник
Регистрация: 04/24/2009
Сообщений: 150
например,

1 Sub Initialize
2 Dim ws As New NotesUIWorkspace
...
59 ForAll item In xlDoc.Items
if Lcase(item.name) = "form" then goto black_label
if Left(item.name, 1) = "$" then goto black_label
....
60 If Not (item.Type = 1) Then 'если не rtitem
...
black_label:
85 End ForAll
...
122 End Sub

 
Для создания сообщения необходимо
аутентифицироваться на сервере
Дополнительно
Статистика форума Именинники
Новый пользователь: Олег Изосимов
Участников: 246
Тем: 166
Сообщений: 415
Нет именинников
Статистика
Самые активные авторы Новые пользователи Наиболее просматриваемы темы
Пользователи Сообщения
Ник Норки...150
Denny71
Мэкс29
Golembiov...19
CarteBlan...17
Duchan15
lmed13
Mitka Aku...13
susinmn10
Kachinkin8
Пользователи Сообщения
Олег Изос...0
yungert0
webguru1
tsibus_s1
nataname0
URSiP0
RK5D0
Эбзеев Ру...0
nuesro1
Илья (Доц...2
Тема Автор Просмотров Ответов
"плюсы" и "минусы" создания са...Ник Норкин5697454
Обсуждаем "Сборщик почты"Duchan3447727
Первое впечатлениеDNN2535413
Экспорт из oracle в lotusslavyan2494313
На сайте, в статьях не работаю...Duchan231953
HTTP POST из кода базыDaime159144
[Domino Designer]Не могу откры...SiM22139976
Lotus Sametime Connect 8.0.2 п...HardCool136451
Lotus CMSKachinkin134613
nginx + dominoNetWood115691
 
© LOGOSPHERE.RU