|
|
|
03/17/2014 04:20:00 PM |
выгрузка документов из lotus notes в excel |
Регистрация: 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
|
|
|
|
Дополнительно |
Статистика форума |
Именинники |
 |
Новый пользователь: rAmantiK
Участников: 247
Тем: 167
Сообщений: 416 |
|
 |
Нет именинников |
|
|
|
Статистика |
Самые активные авторы |
Новые пользователи |
Наиболее просматриваемы темы |
|
|
|
|
|
|