Импорт View из Lotus в Excel макросом

  • Автор темы NickSHDaemon
  • Дата начала
N

NickSHDaemon

Привет всем. Мало опыта, поиском проблему не решил, везде ответы как лотусовским скриптом перегнать вьюшку. А мне
нужно сделать это макросом excel, т.е импортировать содержимое вьюшки Lotus в Excel.
Создал код (упрощенный вариант)
Sub ImportView2Excel()
Dim session As Object
Dim db As Object
Dim view As Object
Dim dataview As Object
Dim As Object
Set session = CreateObject("Notes.Notessession")
Set db = session.getdatabase("", "test.nsf")
Dim i As Integer
Set dataview = db.GetView("view")
Set view = dataview.createViewnav()
Set row_ = view.GetFirstDocument
i = 1
While Not (row_ Is Nothing)
ActiveSheet.Cells(i, 1).Value = doc.columnvalues(1) ' и вот здесь
'возникает Variable uses a type not supported in Visual Basic (Error 458)

Set doc = view.GetNextDocument(doc)
Wend
End Sub
Где я неправ, не могу понять.
Может немного не в тему , скорее это в ветку vba'шников, но все же . Буду рад любому ответу.
 
M

morpheus

1. Пользуйтесь дэбагером
2. Что такое doc. - ??? не декларации, не инициализации
 
G

GROMILA

А вот не надо упрощенных вариантов - программирование это ЛЮБОВЬ К МЕЛОЧАМ!!!!

Эх, отведу душу:
1. Это конечно изврат так юзать лотус и вообще строить решения внутри Excel-файла
2. Сие можно выполнить только вызывая Ком-интерфейсы (вызывая лотусиные методы), так значит сперва нужно научиться в лотусе бродить по вьюхе!!!
3. Нафига тебе навигатор лотусовый - тебе чтоль категории вложенные нужны???? Если нет, то нах его в кочель выкинь - это очень противная штуковина.

Ну да ладно:
Код:
Sub ImportView2Excel()
Dim session As Object
Dim db As Object
Dim view As Variant	' NotesView
Dim vc As Variant	'NotesViewEntryCollection
Dim entry As Variant	'NotesViewEntry
Dim i As Integer

Set session = CreateObject("Notes.Notessession")
Set db = session.getdatabase("", "test.nsf")

Set view = db.GetView("CoolWayToTheLotus")
Set vc = view.AllEntries
Set entry = vc.GetFirstEntry

i = 1
While Not entry Is Nothing

ActiveSheet.Cells(i, 1).Value = entry.ColumnValues(0) ' this is column 1
ActiveSheet.Cells(i, 2).Value = entry.ColumnValues(1) ' this is column 2
ActiveSheet.Cells(i, 3).Value = entry.ColumnValues(2) ' this is column 3

i = i + 1
Set entry = vc.GetNextEntry(entry)
Wend

End Sub
 
N

NickSHDaemon

Спасибо всем за ответ, особенно to GROMILA за простое и элегантное решение.
Спасибо за совет не использовать лотусовый навигатор .

А вот и мое решение проблемы
Sub ImportView2Excel()
Dim session As Object
Dim db As Object
Dim view As Object
Dim dataview As Object
Dim doc As Object
Dim cns As String
Dim colval As Variant
Dim i, row, col As Integer
Set session = CreateObject("Notes.Notessession")
Set db = session.getdatabase("", "test.nsf")
Set dataview = db.GetView("testview")
Set view = dataview.createViewnav()
Set doc = view.GetFirstDocument
row = 1
While Not (doc Is Nothing)
col = 1
For Each colval In doc.ColumnValues
ActiveSheet.Cells(row, col).Value = colval
col = col + 1
Next
row = row + 1
Set doc = view.GetNextDocument(doc)
Wend
End Sub
Но конечно буду использовать решение от GROMILA. Всем спасибо еще раз
 
N

NickSHDaemon

Если еще кому-то интересно.
Свой ответ я дал, только просмотрев глазами код , предоставленный GROMILA.
Когда я попытался исполнить его в Excel, возникла таже ошибка на строчке где присутствует обращение к
entry.ColumnValues(0), т.е.
ActiveSheet.Cells(i, 1).Value = entry.ColumnValues(0).
Хотя я просмотрел кучу доков, именно так это свойство и должно работать.
Но мое решение заработало , может и криво , но задача выполена. Еще раз всем спасибо. Если есть желающие продолжить дискуссию по данному вопросу , буду рад
 
K

Kron

Sub Initialize
Dim view As NotesView
Dim ns As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim j As Integer
Dim i As Integer
Dim st As String

Set db=ns.CurrentDatabase
Set view=db.GetView("view")
view.AutoUpdate = False

Set xl= CreateObject("Excel.Application")
xl.visible = False
xl.Workbooks.Add "d:\name.xls"
Set xlWorkbook = xl.Workbooks(1)
Set xlWorksheet = xlWorkbook.Worksheets(1)

For i=2 To 14
For j=2 To 6
xlWorksheet.cells(i,j).value=0
Next
Next

Set doc=view.GetFirstDocument


While Not(doc Is Nothing)

With xlWorksheet
If Cstr(doc.UpdateContactAgent(0))="Вологда" Then

If Cstr(doc.UpdateContactKriteriu(0))="A - нет решения" Then
.cells(2,2).value=.cells(2,2).value+1
End If
If Cstr(doc.UpdateContactKriteriu(0))=«B - заброшено» Then
.cells(2,3).value=.cells(2,3).value+1
End If
If Cstr(doc.UpdateContactKriteriu(0))="C - в работе" Then
.cells(2,4).value=.cells(2,4).value+1
End If
If Cstr(doc.UpdateContactKriteriu(0))="D - нет данных" Then
.cells(2,5).value=.cells(2,5).value+1
End If
If Cstr(doc.UpdateContactKriteriu(0))="I - оплачен" Then
.cells(2,6).value=.cells(2,6).value+1
End If
End If
If Cstr(doc.UpdateContactAgent(0))="Ижевск" Then
If Cstr(doc.UpdateContactKriteriu(0))="A - нет решения" Then
.cells(3,2).value=.cells(3,2).value+1
End If
If Cstr(doc.UpdateContactKriteriu(0))="B - заброшено" Then
.cells(3,3).value=.cells(3,3).value+1
End If
If Cstr(doc.UpdateContactKriteriu(0))="C - в работе" Then
.cells(3,4).value=.cells(3,4).value+1
End If
If Cstr(doc.UpdateContactKriteriu(0))="D - нет данных" Then
.cells(3,5).value=.cells(3,5).value+1
End If
If Cstr(doc.UpdateContactKriteriu(0))="I - оплачен" Then
.cells(3,6).value=.cells(3,6).value+1
End If
End If
End With
Call doc.Save(True, True)
Set doc=view.GetNextDocument(doc)

Wend
xl.visible=True
xl=""

End Sub
 
K

K-Fire

Эээ, может я чота торможу на ночь, но почему бы не использовать функцию Copy as Table ? Вообще никакого кода не надо :p
 
G

GROMILA

Когда я попытался исполнить его в Excel, возникла таже ошибка на строчке где присутствует обращение к
entry.ColumnValues(0), т.е.
ActiveSheet.Cells(i, 1).Value = entry.ColumnValues(0).

попробуй так
ActiveSheet.Cells(i, 1).Value = CStr(entry.ColumnValues(0))

или
a = entry.ColumnValues(0)
ActiveSheet.Cells(i, 1).Value = a
 
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!