Решено Проверка при сохранении

[k85]

в базе есть проверка на вложение, проверяется на Querysave

 Forall item In Doc.Items
If Ucase(item.Name) = "$FILE" Then
If  Right$( Lcase(item.Values(0) ),4) = ".pdf"  Then
Else
Messagebox "неверный фармат!"
Continue=False
Exit Sub
End If
 
End If
 
End Forall

при создании нового проверяет, потом если открыть на редактирование - проверяет, но если открыть на редактирование вложить файл с неверным расширением, появится сообщение и после этого удалить неверное вложение и вновь его добавить - дает сохранить и не ругается
Что не так ?

 

[lmike]

Что не так ?

обновление РТ полей и вложений происходит сложным образом
ваш код это не учитывает
можно попробовать Update(True), для uidoc, и Update для rtitem (точно действует для текста)
есть еще хак с подменой инмемори дока

Ссылка скрыта от гостей

 

[k85]

уже как только не пробую - не выходит

может можно как-то по другому решить, необходимо во вложениях в Body проверять файлы и разрешать вносить (соответственно сохранять) только в определенных форматах документы, например .doc, .jpeg

 

[erdi]

1) RT поле скрыть, создать свою кнопку "вложить" и там проверять что пользователь выбрал
2) попробуй так

 Continue=False
Dim doc As NotesDocument
Set doc=Source.Document
 
Dim dname As Variant
dname=Evaluate({@AttachmentNames}, doc)
 
If dname(0)<>"" Then
Forall n In dname
If Right( Lcase(n),4) = ".pdf" Then
Continue=True
Exit Sub
End If
End Forall
End If
Messagebox "неверный фармат!"

 

[lmike]

вот набросал:

%REM
*--------------------------------------------
Function UpdateUIdoc
Description: Comments for Function
%END REM
Function UpdateUIdoc(uidoc As NotesUIDocument, rtName As String) As NotesUIDocument
Dim routineName As String
routineName="UpdateUIdoc"
On Error GoTo ErrH
'your code here
	Dim wksp As New NotesUIWorkspace
	Dim ses As New NotesSession
	Dim uidocNew As NotesUIDocument
	Dim doc As NotesDocument
	Dim rti As NotesRichTextItem
	Dim strFieldname As String
 
	uidoc.Refresh True ' do this if the rich text field is editable, to get the current contents in case user has modified them.
	Set doc = uidoc.Document  ' get the back-end document for the document open on screen.
	strFieldname = uidoc.CurrentField ' remember the current field if any
	Set rti = doc.GetFirstItem(rtName)
	rti.Update
	Dim newdoc As NotesDocument, unid As String
	unid=doc.Universalid
	Set newdoc=ses.Currentdatabase.Createdocument()
	Call doc.Copyallitems(newdoc, True) 
	doc.SaveOptions = "0" ' In order to close the document without a "do you want to save" prompt. If this is a mail-in doc you may need to set MailOptions="0" also to avoid being prompted.
	Call uidoc.Close(True)
	Delete uidoc
	Set doc=GetDocumentByUNIDSilent(ses.Currentdatabase,unid)
	ForAll itm In doc.Items
		Dim tmp As NotesItem
		Set tmp=itm
		Call tmp.Remove()
	End ForAll
	Call newdoc.Copyallitems(doc,True)
	Set uidocNew = wksp.EditDocument(True, doc, , , , True)
	If Len(strFieldname) > 0 Then uidocNew.GotoField(strFieldname) 
Set UpdateUIdoc=uidocNew
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function

использование

Sub Querysave(Source As Notesuidocument, Continue As Variant)
Continue=True
Set Source=UpdateUIdoc(Source, {body})
If HasAttachmentName(Source.Document, {*.docx}) Then Msgbox {Attach is not valid}:Continue=False:Exit Sub
Source.Document.Save True, False
End Sub

ф-ции для аттачей

Function AttachmentsName(objdoc As NotesDocument) As Variant
AttachmentsName=Evaluate("@AttachmentNames(0)", objdoc)
End Function
Function HasAttachmentName(objdoc As NotesDocument, wildcard As String) As Boolean
	Dim arr As Variant
	arr=AttachmentsName(objdoc)
	If Not IsEmpty(arr) Then
		If IsArray(arr) Then
			ForAll a In arr
				If CStr(a) Like wildcard Then
					HasAttachmentName=True
					Exit Function
				End If
			End ForAll
		Else
			If CStr(arr) Like wildcard Then
				HasAttachmentName=True
			End If
		End If
	End If
End Function

[DOUBLEPOST=1436793735,1436793612][/DOUBLEPOST]получение дока из дб оформлена так

Function GetDocumentByUNIDSilent(db As NotesDatabase, UNID As String) As NotesDocument
	On Error GoTo ErrH
	Dim doc As NotesDocument
	Set doc = db.GetDocumentByUNID(UNID)
	If doc.IsValid And Not doc.IsDeleted Then
		'проверка - если, например, недоступен по readers
		If doc.Size > 0 Then
			Set GetDocumentByUNIDSilent = doc
		End If
	End If	
Quit:
	Exit Function
ErrH:
'   RaiseError
	Resume Quit
End Function

 

[k85]

@lmike,
спасибо! буду пробовать и разбираться

 

[k85]

извиняюсь, не могу разобраться немного
все работает классно, если документ уже был и его просто редактировать, а если новый, то пишет что ошибка в этой строке
Set Source=UpdateUIdoc(Source, {body})

 

[lmike]

то пишет что ошибка в этой строке

ну звиняйте - я забыл про новые доки, надо в код добавить проверку, на новизну дока и просто использовать newdoc (при получении uidocNew)

 

[lmike]

после uidoc.Close(True) д.б.

	Dim isnew As Boolean
	isnew=doc.Isnewnote
	Delete uidoc
	If Not isnew Then
		Set doc=GetDocumentByUNIDSilent(ses.Currentdatabase,unid)
		ForAll itm In doc.Items
			Dim tmp As NotesItem
			Set tmp=itm
			Call tmp.Remove()
		End ForAll
		Call newdoc.Copyallitems(doc,True)
	Else
		Set doc=newdoc
	End If

сами сопоставьте код
[DOUBLEPOST=1436809183,1436809067][/DOUBLEPOST]удаление всех айтемов из дока (OnDisk) - м.б. что-то более оптимальное есть, но я заленился

 

[k85]

при использовать newdoc (при получении uidocNew) , ошибка
если использовать дебагер , то видно, что в новом документе все поля копируются, а файлы не в само поле Body помещаются, а ниже (вне полей)

 

[lmike]

при использовать newdoc (при получении uidocNew) , ошибка

код выше не работает?

 

[k85]

сейчас все удалю и заново попробую, так как не вышло, и уже не могу найти всех своих изменений. лучше все с нуля буду пробовать, просто для новых появилась опять проблема в этом месте Set Source=UpdateUIdoc(Source, {body})

 

[k85]

@lmike, спасибо огромнейшее, все заработало, после создания с нуля, все работает отлично

 

[k85]

появилась небольшая проблема, ранее после проверки переходило на Queryclose, где запускается заполение протокола изменений документа, а теперь после querysave далее не проходит по остальным и получается не заполняется протокол

 

[lmike]

а теперь после querysave далее не проходит

оно и понятно - объект убит

 

[k85]

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

если в конце, то уже объекта нет (

 

[lmike]

а история должна уже будет сохраниться.

если не захочет сохраняться док - до квери-сэйв не дойдет
а если не захочет после запроса - дык записать протокол уже можно было (на QS)
[DOUBLEPOST=1437398788,1437398630][/DOUBLEPOST]короче - всё можно определить на QS и обновление, вернее код по проверкам перенести в обновление, а на QS вызывать ViewRefresh

 

[lmike]

еще вариант - вызывать самому

Sub Querysave(Source As Notesuidocument, Continue As Variant)
Continue=True
Set Source=UpdateUIdoc(Source, {body})
If HasAttachmentName(Source.Document, {*.docx}) Then Msgbox {Attach is not valid}:Continue=False:Exit Sub
Source.Document.Save True, False
Call PostSave(Source)
End Sub

при условии что знаем что делаем
[DOUBLEPOST=1437411929,1437411909][/DOUBLEPOST]и кстати - QueryClose отрабатывается и так
[DOUBLEPOST=1437412067][/DOUBLEPOST]

,а история должна уже будет сохраниться

а вот с этого места поподробнее - где история, что это?

 

[k85]

в базе на queryclose выполняется проверка соотвествия полей и вносится в поле информация, если изменили определенные поля, т.е. функция находится там
но у меня на querysave (если смотреть дебагером) все выполняется , ошибок нет,
проходит
If HasAttachmentName...
Source.Document.Save True, False
Call PostSave(Source) - переходит и возвращает назад на querysave
End If

End Sub
и выходит

 

[lmike]

Call PostSave(Source) - переходит и возвращает назад на querysave

правильно, и что смущает?