K
kilcher
Всем добрый день!
Написала код для передачи данных из полей одного документа в поля другого. После выбора документа выдает ошибуbject variable not set. Где ошибка в коде не пойму :blink: .
Пожалуйста,если можно помогите!!! Вот код:
Sub Click(Source As Button)
Dim reviewCol As NotesDocumentCollection
Dim reviewDoc As NotesDocument
Dim ws As New NotesUIWorkspace
Dim reviewdb As NotesDatabase, db As NotesDatabase
Set reviewdb = ws.currentDatabase.Database
Dim doc As NotesDocument
Dim i As Long
Dim IsNameListEmpty As Variant
Dim uidoc As NotesUIDocument
Dim revNamerus() As String,revNamelot() As String,revPosition() As String
'Поле множественное, добавить возможность пополнять и очищать список замов
'
Set doc = ws.CurrentDocument.Document
Set uidoc= ws.CurrentDocument
' Выбираем карточки сотрудников
'Set Collection = Ws.PickListCollection( 1,true, server$ ] [, databaseFileName$ ] [, viewName$ ] [, title$ ] [, prompt$ ] [, Singlecategory$ ] )
Set reviewCol = ws.PickListCollection(PICKLIST_CUSTOM, True, reviewdb.Server, reviewdb.FilePath, "(Сотрудники)", "Выбор согласующего", "Выберите нужную карточку" )
If reviewCol.count = 0 Then Exit Sub
If reviewDoc.HasItem("revNameRus") Then
max = Ubound(reviewDoc.revNameRus)
Else
max = 0
End If
Redim revNamerus(max)
Redim revNamelot(max)
Redim revPosition(max)
' определяем временные массивы для хранения списка dbpbhe.ob[ и связанных полей
If reviewDoc.HasItem("revNameRus") Then
If max >0 Or reviewDoc.revNameRus(0) <> "" Then
For i=Lbound(reviewDoc.revNameRus) To Ubound(reviewDoc.revNameRus)
revNamerus(i) = reviewDoc.revNameRus(i)
Next
Goto InitiateLists
End If
End If
' Если список имен пуст, то и все связанные поля считаем пустыми
revNamerus (0)=""
revNamelot(0) =""
revPosition(0) = ""
Goto FillDeputyFields
' Если список имен не пуст, присваиваем значения другим спискам
InitiateLists:
If reviewDoc.HasItem("revpositions") Then
For i=0 To max
If i > Ubound(reviewDoc.revpositions) Then
revPosition(i) = "Без должности"
Else
revPosition(i) = reviewDoc.revpositions(i)
End If
Next
Else
For i=0 To max
revPosition(i) = "Без должности"
Next
End If
'имя сотрудника в Lotus
If reviewDoc.HasItem("revNamelotus") Then
If max >0 Or reviewDoc.revNamelotus(0) <> "" Then
For i=Lbound(reviewDoc.revNamelotus) To Ubound(reviewDoc.revNamelotus)
revNamelot(i) = reviewDoc.revNamelotus(i)
Next
End If
End If
' Добавляем новые значения к списку визирующих лиц
FillDeputyFields:
For i = 1 To collection.count
Set doc = collection.GetNthDocument(i)
If max >0 Or revNamerus(0) <> "" Then
max = max +1
Redim Preserve revNamerus (max)
Redim Preserve revNamelot (max)
Redim PreserverevPosition (max)
End If
' присваиваем значения имени визирующего лица
If Not doc.HasItem("p1") Then
revNamerus (max) = "нет визирующих лиц"
Elseif doc.p1(0) ="" Then
revNamerus (max) = "нет визирующих лиц"
Else
revNamerus (max) = doc.p1(0)
End If
' должность
If doc.Way(0) = "" Then
revPosition (max) = "Без должности"
Elseif Not doc.HasItem("p10") Then
revPosition (max) = doc.Way(0) + "\Без должности"
Elseif doc.p10(0) = "" Then
revPosition (max) = doc.Way(0) + "\Без должности"
Else
revPosition (max) = doc.Way(0) + "\" + doc.p10(0)
End If
' Lotus имя
If Not doc.HasItem("LotusName") Then
revNamelot (max) = "лотус имя"
Elseif doc.LotusName(0) ="" Then
revNamelot (max) = "нет лотус имени"
Else
revNamelot (max) = doc.LotusName(0)
End If
Next
reviewDoc.revNameRus = revNamerus
reviewDoc.revNamelotus = revNamelot
reviewDoc.revpositions =revPosition
Call uidoc.Refresh
End Sub
Написала код для передачи данных из полей одного документа в поля другого. После выбора документа выдает ошибуbject variable not set. Где ошибка в коде не пойму :blink: .
Пожалуйста,если можно помогите!!! Вот код:
Sub Click(Source As Button)
Dim reviewCol As NotesDocumentCollection
Dim reviewDoc As NotesDocument
Dim ws As New NotesUIWorkspace
Dim reviewdb As NotesDatabase, db As NotesDatabase
Set reviewdb = ws.currentDatabase.Database
Dim doc As NotesDocument
Dim i As Long
Dim IsNameListEmpty As Variant
Dim uidoc As NotesUIDocument
Dim revNamerus() As String,revNamelot() As String,revPosition() As String
'Поле множественное, добавить возможность пополнять и очищать список замов
'
Set doc = ws.CurrentDocument.Document
Set uidoc= ws.CurrentDocument
' Выбираем карточки сотрудников
'Set Collection = Ws.PickListCollection( 1,true, server$ ] [, databaseFileName$ ] [, viewName$ ] [, title$ ] [, prompt$ ] [, Singlecategory$ ] )
Set reviewCol = ws.PickListCollection(PICKLIST_CUSTOM, True, reviewdb.Server, reviewdb.FilePath, "(Сотрудники)", "Выбор согласующего", "Выберите нужную карточку" )
If reviewCol.count = 0 Then Exit Sub
If reviewDoc.HasItem("revNameRus") Then
max = Ubound(reviewDoc.revNameRus)
Else
max = 0
End If
Redim revNamerus(max)
Redim revNamelot(max)
Redim revPosition(max)
' определяем временные массивы для хранения списка dbpbhe.ob[ и связанных полей
If reviewDoc.HasItem("revNameRus") Then
If max >0 Or reviewDoc.revNameRus(0) <> "" Then
For i=Lbound(reviewDoc.revNameRus) To Ubound(reviewDoc.revNameRus)
revNamerus(i) = reviewDoc.revNameRus(i)
Next
Goto InitiateLists
End If
End If
' Если список имен пуст, то и все связанные поля считаем пустыми
revNamerus (0)=""
revNamelot(0) =""
revPosition(0) = ""
Goto FillDeputyFields
' Если список имен не пуст, присваиваем значения другим спискам
InitiateLists:
If reviewDoc.HasItem("revpositions") Then
For i=0 To max
If i > Ubound(reviewDoc.revpositions) Then
revPosition(i) = "Без должности"
Else
revPosition(i) = reviewDoc.revpositions(i)
End If
Next
Else
For i=0 To max
revPosition(i) = "Без должности"
Next
End If
'имя сотрудника в Lotus
If reviewDoc.HasItem("revNamelotus") Then
If max >0 Or reviewDoc.revNamelotus(0) <> "" Then
For i=Lbound(reviewDoc.revNamelotus) To Ubound(reviewDoc.revNamelotus)
revNamelot(i) = reviewDoc.revNamelotus(i)
Next
End If
End If
' Добавляем новые значения к списку визирующих лиц
FillDeputyFields:
For i = 1 To collection.count
Set doc = collection.GetNthDocument(i)
If max >0 Or revNamerus(0) <> "" Then
max = max +1
Redim Preserve revNamerus (max)
Redim Preserve revNamelot (max)
Redim PreserverevPosition (max)
End If
' присваиваем значения имени визирующего лица
If Not doc.HasItem("p1") Then
revNamerus (max) = "нет визирующих лиц"
Elseif doc.p1(0) ="" Then
revNamerus (max) = "нет визирующих лиц"
Else
revNamerus (max) = doc.p1(0)
End If
' должность
If doc.Way(0) = "" Then
revPosition (max) = "Без должности"
Elseif Not doc.HasItem("p10") Then
revPosition (max) = doc.Way(0) + "\Без должности"
Elseif doc.p10(0) = "" Then
revPosition (max) = doc.Way(0) + "\Без должности"
Else
revPosition (max) = doc.Way(0) + "\" + doc.p10(0)
End If
' Lotus имя
If Not doc.HasItem("LotusName") Then
revNamelot (max) = "лотус имя"
Elseif doc.LotusName(0) ="" Then
revNamelot (max) = "нет лотус имени"
Else
revNamelot (max) = doc.LotusName(0)
End If
Next
reviewDoc.revNameRus = revNamerus
reviewDoc.revNamelotus = revNamelot
reviewDoc.revpositions =revPosition
Call uidoc.Refresh
End Sub