Изменить автоматически Location и Connection

Sub Click(Source As Button)
System variables -> DO NOT CHANGE!!!!
Const VIEW_LOCATION_NAME = "($Locations)"
Const VIEW_CONNECTION_NAME = "($Connections)"
 
Application variables -> EDIT THESE ONES!!!!
Const OLD_DOMAIN_NAME = "1"   This is the value of your old domain
Const NEW_DOMAIN_NAME = "2"  This is the value of your new domai
Dim session As New NotesSession
Dim dbNab As NotesDatabase
Dim view As NotesView
Dim note As NotesDocument
Dim sNamesLine As String
Dim nPos As Integer
Dim sDomainValue As String
Dim bNeedsUpdate As Integer
Dim bLocationModified As Integer
 
On Error Resume Next
 
first, get the local NAB
sNamesLine = session.GetEnvironmentValue("names",True)
 
nPos = Instr(sNamesLine, ",")
If nPos > 0 Then
sNamesLine = Left$(sNamesLine, nPos-1)
Else
sNamesLine = "names.nsf"
End If
 
Set dbNab = New NotesDatabase( "",sNamesLine )
 
If Not(dbNab.isOpen) Then
Messagebox("Не удалось найти Вашу Адресную книгу.")
Exit Sub
End If
 
update all location documents
Set view = dbNab.GetView(VIEW_LOCATION_NAME)
If (view Is Nothyng) Then
Messagebox("Ваша Адресная книга отсутствует.")
Exit Sub
End If
 
Set note = view.GetFirstDocument
 
While Not(note Is Nothyng)
sDomainValue = note.Domain(0)
If Lcase(sDomainValue) = Lcase(OLD_DOMAIN_NAME) Then
note.Domain = NEW_DOMAIN_NAME
note.MailServer="Новый сервер"
Call note.save(True,False)
bLocationModified = True
End If
Set note = view.GetNextDocument(note)
Wend
 
If (bLocationModified) Then Messagebox("Вы должны переоткрыть Notes для того, чтобы изменения вступили в силу.")
 
update all connection documents
Set view = dbNab.GetView(VIEW_CONNECTION_NAME)
If (view Is Nothyng) Then
Messagebox("Ваша Адресная книга отсутствует.")
Exit Sub
End If
 
Set note = view.GetFirstDocument
 
While Not(note Is Nothyng)
bNeedsUpdate = False
sDomainValue = note.SourceDomain(0)
If Lcase(sDomainValue) = Lcase(OLD_DOMAIN_NAME) Then
note.SourceDomain = NEW_DOMAIN_NAME
note.MailServer="Новый сервер"
bNeedsUpdate = True
 
End If
sDomainValue = note.DestinationDomain(0)
If Lcase(sDomainValue) = Lcase(OLD_DOMAIN_NAME) Then
note.SourceDomain = NEW_DOMAIN_NAME
note.MailServer="Новый сервер"
bNeedsUpdate = True
End If
If (bNeedsUpdate) Then Call note.save(True, False)
Set note = view.GetNextDocument(note)
Wend
End Sub

            Dim ws As NotesUIWorkspace
Set doc = db.CreateDocument
note.form = "Connection"
note.Destination="сервер"
note.OptionalNetworkAddress="адрес"
Call note.Save( True, True )

        Set note = db.CreateDocument
note.form = "Connection"
note.DisplayName="название"
note.Destination="сервер"
note.OptionalNetworkAddress="адрес"
Call note.Save( True, True )

Sub AddOneConnection(namedb As NotesDatabase, Server As String, DNS As String )
On Error Goto ErrHnd
 
Static view As NotesView
Dim doc As NotesDocument
Dim ServerNN As NotesName
 
If view Is Nothyng Then
Set view=namedb.GetView("Connections")
Else
If namedb.ReplicaID <> view.Parent.ReplicaID Then Set view=namedb.GetView("Connections")
End If
If view Is Nothyng Then Error 1001, "Не найден вид Connections в адресной книге " & namedb.FilePath & ""
 
Set ServerNN = New NotesName( Server )
 
*******проверяем на наличие и создаем подключение
Set doc=view.GetDocumentByKey( ServerNN.Abbreviated )
If Not doc Is Nothyng Then
Подключение к серверу обнаружено. Производится модификация...
Else
Подключение к серверу не обнаружено. Создание нового....
Set doc = namedb.CreateDocument
doc.Form="local"
End If
 
doc.ConnectionType="0"
doc.OptionalNetworkAddress=DNS
doc.LanportName="TCPIP"
doc.Destination = ServerNN.Canonical
doc.Source="*"
Call doc.ComputeWithForm(True,False)
call doc.Save(False, False)
Exit Sub
ErrHnd:
On Error Goto 0
Error Err, Error$ & Chr(10) & Getthreadinfo(1) & " (line " & Erl & ")"
End Sub

 first, get the local NAB
sNamesLine = session.GetEnvironmentValue("names",True)

 first, get the local NAB
sNamesLine = session.GetEnvironmentValue("names",True)