O
oleg7
Мне необходимо отослать письмо группе пользователей, в этом письме должна быть кнопка, при нажатии на которую у пользователя должен изменитьсяв Location: Home/mail server и Domen, т.е. главный почтовый сервер и домен. А также в Connection создать новое подключение к серверу
нашел на форуме, чуть добавил:
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 Nothing) Then
Messagebox("Ваша Адресная книга отсутствует.")
Exit Sub
End If
Set note = view.GetFirstDocument
While Not(note Is Nothing)
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 Nothing) Then
Messagebox("Ваша Адресная книга отсутствует.")
Exit Sub
End If
Set note = view.GetFirstDocument
While Not(note Is Nothing)
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