Снова возникла задача массово подрихтовать документы подключения у пользователей, убрать лишнее, посидев вечерочком....подумав ...попечатав ... вот что получилось
Sub create_connect
On Error Goto errmes
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim strErrMessage,connect,dserver
Dim s As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim coll As NotesDocumentCollection
Dim doc As NotesDocument
Dim coldoc As NotesDocument
Set db = s.GetDatabase("","names.nsf")
Set view = db.GetView("Connections")
'*****************************
connect = "server/domain"
'*****************************
Set coll = view.Getalldocumentsbykey(connect)
Stop
If coll.Count > 1 Then
'если в коллекции найдены несколько документов, то проверить у них интернет-хост
'если он не удовлетворяет условию, удалить документы не удовлетворяющие условию
Set doc = coll.Getfirstdocument
While Not(doc Is nothing)
If doc.Destination(0) = "CN=server/O=domain" Then
If Not (doc.OptionalNetworkAddress(0) = "server_inet_host") Then
Call doc.Removepermanently(True)
Call ws.Viewrefresh()
End If
End If
Set doc = coll.Getnextdocument(doc)
Wend
'если в коллекции найден один документ, то проверить у него интернет-хост
'и если он не удовлетворяет условию, то переписать значение на нужное
ElseIf coll.Count = 1 Then
Set doc = coll.Getfirstdocument
If Not doc.OptionalNetworkAddress(0) = "server_inet_host" Then
Call doc.ReplaceItemValue("OptionalNetworkAddress", "server_inet_host")
Call doc.ReplaceItemValue("PhoneNumber", "server_inet_host")
Call doc.Save(True,False)
End If
'если нет документа, то создать заново
ElseIf coll.Count = 0 Then
Set uidoc = ws.ComposeDocument( "", db.filename, "local" )
Call uidoc.FieldsetText("Destination","CN=server/O=domain")
Call uidoc.FieldsetText("OptionalNetworkAddress","server_inet_host")
Call uidoc.FieldsetText("PhoneNumber","server_inet_host")
Call uidoc.FieldsetText("PortName","TCPIP")
Call uidoc.FieldsetText("LanPortName","TCPIP")
Call uidoc.Save
Call uidoc.Close
Print "Документ подключения " & connect &" cоздан"
End if
'сообщение об ошибке
Exit Sub
errmes:
strErrMessage = "Ошибка " & Error$ & " выполняемая процедура " & Getthreadinfo(10) &" текущая процедура " & Getthreadinfo(1) & ", в строке " & Cstr(Erl)
Print strErrMessage
End sub
16 марта 2010 г.
Подписаться на:
Комментарии к сообщению (Atom)
Комментариев нет:
Отправить комментарий