Создать документ в другой базе

  • Автор темы LIGHT
  • Дата начала
L

LIGHT

Коллеги, нужна помощь.

Есть кнопка, кнопая на которую требудется создать документ(s) в другой базе.
От чего можно начать плясать???
База на этом же серваке.
Создаватся док должен по форме "FORM1"
И заполняться чать поле, TITLE, STATUS, ETC
 
M

morpheus

Для: LIGHT

Код: 
Dim session As New NotesSession
Dim doc As NotesDocument
Dim db As NotesDatabase
Set db = New NotesDatabase( "Barcelona", "plan.nsf" )
Set doc = db.CreateDocument
doc.Form = "FORM1"
doc.TITLE = "New building"
doc.STATUS = "1"
...
Call doc.Save( True, True )



Set db = New NotesDatabase( "Barcelona", "plan.nsf" ) - ну собственно здесь и прописывайте сервер и файл базы
 
L

LIGHT

Получилось, второй вопрос по пути.
Поле BODY ричтекст, я туда помещаю текстовое значение а еще охото ссылку на документ источник сунуть. Как это можно сделать?
 
M

morpheus

<!--QuoteBegin-LIGHT+19:09:2007, 13:39 -->
<span class="vbquote">(LIGHT @ 19:09:2007, 13:39 )</span><!--QuoteEBegin-->Поле BODY ричтекст, я туда помещаю текстовое значение а еще охото ссылку на документ источник сунуть. Как это можно сделать?
[snapback]78806" rel="nofollow" target="_blank[/snapback]​
[/quote]
AppendDocLink method у NotesRichTextItem

Код: 
Set newDoc = New NotesDocument( db )
Set rtitem = New NotesRichTextItem( newDoc, "Body" )
Call rtitem.AppendDocLink( db, db.Title )
 
L

LIGHT

<!--QuoteBegin-Morpheus+19:09:2007, 14:57 -->
<span class="vbquote">(Morpheus @ 19:09:2007, 14:57 )</span><!--QuoteEBegin-->Set newDoc = New NotesDocument( db )
Set rtitem = New NotesRichTextItem( newDoc, "Body" )
Call rtitem.AppendDocLink( db, db.Title )
[snapback]78808" rel="nofollow" target="_blank[/snapback]​
[/quote]
А как это подружить грамотно с тем что выше, что-то не получается.
 
M

morpheus

Код: 
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim Gdoc As NotesDocument
Set uidoc = workspace.CurrentDocument
Set Gdoc = uidoc.Document
Dim session As New NotesSession
Dim doc As NotesDocument
Dim db As NotesDatabase
Set db = New NotesDatabase( "Barcelona", "plan.nsf" )
Set doc = db.CreateDocument
doc.Form = "FORM1"
doc.TITLE = "New building"
doc.STATUS = "1"
Call doc.Save( True, True )
Set rtitem = New NotesRichTextItem( doc, "Body" )
Call rtitem.AppendDocLink( GDoc, "Ссылка на гл.докумень" )
Call doc.Save( True, True )
 
L

LIGHT

Спасибо все получилось
Еще вопросик:

Есть в документе поле много занчано типа Author
Заморочка в том что делаю такую фишку

if(GDoc.Users(0) <> Then

End If

На этой стоке скрипт затыкается если в поле всего 1 значение если несколько то все ок.
Что за байда, уже голову сломил.
 
M

morpheus

Скрипт неполный нифига не ясно
точто приведено даже не скомпилиться. ткам попросту не закрыта одна скобка
 
L

LIGHT

Очепятался пишу с другой машины, Copy Paste ни как :)
Затык в том что есть поле на форме, туда LN имена юзеров загоняются.
Дальше я проверяю больше ли пустоты там их

if(GDoc.Users(0)) <> Then

Дебагер ругается на эту сроку если там 1 юзер, если больше все хорошо., вот репу и чешу....
 
M

morpheus

<!--QuoteBegin-LIGHT+19:09:2007, 16:34 -->
<span class="vbquote">(LIGHT @ 19:09:2007, 16:34 )</span><!--QuoteEBegin-->if(GDoc.Users(0)) <> Then
[snapback]78837" rel="nofollow" target="_blank[/snapback]​
[/quote]
Что это за скрипт.. что Вы с чем сравниваете??

if Len(GDoc.Users(0)) > 0 Then - хотя бы так для начала
 
L

LIGHT

Ваш вариант тоже не катит.
Привожу код
Код: 
Sub Click(Source As Button)

'получим настройки
Dim ns As notessession
Dim ws As notesuiworkspace
Dim sdb As notesdatabase
Dim sv As notesview  ' вид для поиска настроек
Dim sdoc As notesdocument	' документ настроек
Dim note As notesuidocument	' новый документ настроек, если оный не найден

Set ns = New notessession	
Set ws = New notesuiworkspace
Set sdb = ns.currentdatabase
Set sv = sdb.getview("Settings")
Set sdoc = sv.getfirstdocument

Dim Serv As Variant
Dim Files As Variant

Serv = sdoc.Serv(0)
Files = sdoc.Files(0)

If(Serv = "" Or Files ="") Then
Messagebox ("Обратитесь к администратору, не правильные настройки базы данных")	
Exit Sub
End If

Dim worckspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim Gdoc As NotesDocument
Set uidoc = worckspace.CurrentDocument
Set Gdoc = uidoc.Document
Dim session As New NotesSession
Dim doc As NotesDocument
Dim db As NotesDatabase
Set db = New NotesDatabase(Serv , Files )
Set doc = db.CreateDocument


'Отправка контролеру если есть

' Ошибка тут
If GDoc.ControlLN(0) <> "" Then


'Проверим есть ли ИО у контролера
If GDoc.ControlLN(1) <>"" Then
AddTitle = "ИО - "
doc.SendToActаasing = GDoc.ControlLN(1)'
Print "Отправление " + GDoc.ControlLN(1)
End If
doc.Form = "Memo"
doc.Body = " "
doc.EnterSendFrom = "NoBody" 'от кого
doc.From = "Обращения" ' из какой БД
doc.IsInformationNotice = "1"
doc.SendTo = GDoc.ControlLN(0) ' Кому LN имя
doc.SendToRus = GDoc.ControlRealExecName(0) ' Кому имя
doc.SourceUNIDDoc = "" ' ID документа
doc.Subject = AddTitle + "Об № " + GDoc.RegNum(0) + " " + Gdoc.AuthorObr(0) +" " + GDoc.Type(0) + ": " +GDoc.Title(0)
Call doc.Save( True, True )
Set rtitem = New NotesRichTextItem(doc,"Body")
Call rtitem.AppendDocLink (GDoc, "Документ")
Call rtitem.AddTab( 1 )
Call rtitem.AppendText( "Вам направлен на контроль документ из Базы данных 'Обращение'" )
Print "Отправление " + GDoc.ControlLN(0)
Call doc.Save( True, True )
Print "Отправление документа контролеру завершено"
Else
Print "Контролеры не указаны"
End If

End Sub
Если выделеное красным поле содержит 2 элемента (2 юзера) ошибок нет, скрипт успешно работает, если 1 значение - ошибка!
 
M

Medevic

Что это ? :)
Green Team
10.12.2004
3 334
1
BIT
6
Красным выделено, наверное, это?
<!--QuoteBegin-LIGHT+19:09:2007, 17:52 -->
<span class="vbquote">(LIGHT @ 19:09:2007, 17:52 )</span><!--QuoteEBegin-->If GDoc.ControlLN(1) <>"" Then
[snapback]78840" rel="nofollow" target="_blank[/snapback]​
[/quote]
Массив значений поля начинается с 0-го элемента, а не 1-го.
 
M

morpheus

аа.. ну теперь понятно, зачем біло кидать куски непонятного кода в котором ничего не ясно?
канечно ві обращаетесь к несуществующему єлементу и Вам тутже даеться ошибка, начинать надо с 0
 
L

LIGHT

Читайте код правильно!
Там 2 сравнения

1. If GDoc.ControlLN(0) <> "" Then
2. If GDoc.ControlLN(1) <>"" Then

Затыкается на первом :)
Я это и отметил по ходу кода.

Если не сложно подскажите как еще можно проверить существует ли элемент???
 
M

morpheus

Для начала в дебагере проверить заполнена ли вообще поле ControlLN !
проверить просто .

для начала какая именно ошибка? Type mistmatch ?
 
L

LIGHT

Нет не Type mistmatch, с этим было бы проще :)
Пишит Subscript out of range

Всем спасибо большое, разобрался. Точно была проблема у несуществующим элементом массива.
Создал в форме поле кторое имеет точное значение.
 
S

Sandr

LIGHT сказал(а):
Читайте код правильно!
Там 2 сравнения

1. If GDoc.ControlLN(0) <> "" Then
2. If GDoc.ControlLN(1) <>"" Then

Затыкается на первом :)
Я это и отметил по ходу кода.

Если не сложно подскажите как еще можно проверить существует ли элемент???
Нажмите, чтобы раскрыть...

Ну ведь выше помоемц ясно написаали, что ошибка тут 2. If GDoc.ControlLN(1) <>"" Then

Откуда возмется (1), если в масиве один элемент? Нулевой только есть...

Замените ту строчку кодом:

If UBound(GDoc.ControlLN) >0 Then
 
Для ответа нужно войти/зарегистрироваться
Мы в соцсетях:

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

Верх Низ