Форум продуктов IBM Lotus
Продукты IBM Lotus => IBM Lotus Notes & Domino => Тема начата: Daniil от 28 Февраль 2014, 12:14:32
-
Добрый день! Появился такой вопрос: есть скрипт для агента, но он выгружает все поля документа скопом в excel...каким образом можно выгружать определенные поля документа, например: registration_number, Registration_Date и т.д., заранее благодарен!
-
Добрый день, подправить агента, чтобы он выгружал только нужные поля:)
-
да понятное дело))) мне б хотя бы примерчик выгрузки 1 поля чтобы было из чего плясать)))) а то просто не особо в этом разбираюсь)))
-
У вас же есть скрипт, который выгружает все поля, модифицируйте его.
Или приведите его здесь, мы подскажем в каком месте изменить.
-
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