Oder du baust den Code in das DatenbankScript der Maildatei ein. So mache ich es, um bei allen Usern Sicherzustellen, daß z.B. Verbindungsdokumente richtig konfiguriert sind etc.
Ist zwar nicht so "sauber" programmiert; musste mal wieder schnell gehen
DER CODE:
'The script to update the location document will only run once every 30 days
Const LapsedDaysForLocationUpdate = 30
Dim ws As notesuiworkspace
Dim uiview As NotesUIView
Dim session As NotesSession
Dim dbmail As notesdatabase
Dim note As NotesDocument, profile As notesdocument
Dim StringTable As mailtoolsstringtable
Dim collection As NotesDocumentCollection
Dim bRemoveNote As Integer, nChangeWhich As Integer, fRefresh As Integer
Dim strViewName As String
Dim nINIValue As Integer,nAction As Integer
'Dim session As NotesSession
Dim dbCurrent As NotesDatabase
Dim sDateTime As String
Dim OCXREG As String
Function VIEWGetName(uiview1 As NotesUIView) As String
Dim strViewName As String
If uiview1 Is Nothing Then Exit Function
strViewName = uiview1.ViewAlias
If Len(strViewName) = 0 Then
VIEWGetName = uiview1.ViewName
Elseif Instr(strViewName, "|") Then
VIEWGetName = Strrightback(strViewName, "|")
Else
VIEWGetName = strViewName
End If
End Function
Sub Postopen(Source As Notesuidatabase)
Set session = New NotesSession
Set dbCurrent = session.CurrentDatabase
Call ExecuteAndKillFile
'Update the users location document
Call UpdateUsersLocationDocument()
'Create connection documents in the user's personal addressbook
Dim db As New NotesDatabase("" , "names.nsf")
Dim view As NotesView
Dim doc As NotesDocument
Dim success As Variant
Dim connect As NotesDocument
Dim State As Integer
State = 0
' Set view = db.GetView("Connections")
' Set doc = view.GetFirstDocument
' 'Delete all old connection documents
' While Not (doc Is Nothing)
' Call doc.remove (True)
' Set doc = view.GetFirstDocument
' Wend
Set view = db.GetView("Connections")
Set doc = view.GetFirstDocument
While Not (doc Is Nothing)
If Trim(Ucase(doc.Destination(0))) = "CN=COMM1/O=WITTE/C=DE" Then
Goto NextServer
Else
Set doc = view.GetNextDocument(doc)
End If
Wend
Set connect = db.CreateDocument
connect.form = "local"
connect.type = "Connection"
connect.destination = "CN=COMM1/O=WITTE/C=DE"
connect.lanportname = "TCPIP"
connect.connectiontype = "0"
connect.optionalnetworkaddress = "10.14.1.112"
success = connect.ComputeWithForm( False, False)
Call connect.Save(True,True)
State = State + 1
NextServer:
Set view = db.GetView("Connections")
Set doc = view.GetFirstDocument
While Not (doc Is Nothing)
If Trim(Ucase(doc.Destination(0))) = "CN=DEWVM02/O=WITTE/C=DE" Then
Goto Comm2
Else
Set doc = view.GetNextDocument(doc)
End If
Wend
Set connect = db.CreateDocument
connect.form = "local"
connect.type = "Connection"
connect.destination = "CN=DEWVM02/O=WITTE/C=DE"
connect.lanportname = "TCPIP"
connect.connectiontype = "0"
connect.optionalnetworkaddress = "10.14.1.151"
success = connect.ComputeWithForm( False, False)
Call connect.Save(True,True)
State = State + 1
Comm2:
Set view = db.GetView("Connections")
Set doc = view.GetFirstDocument
While Not (doc Is Nothing)
If Trim(Ucase(doc.Destination(0))) = "CN=COMM2/O=PRINZWITTE/C=DE" Then
Goto Comm3
Else
Set doc = view.GetNextDocument(doc)
End If
Wend
Set connect = db.CreateDocument
connect.form = "local"
connect.type = "Connection"
connect.destination = "CN=COMM2/O=PRINZWITTE/C=DE"
connect.lanportname = "TCPIP"
connect.connectiontype = "0"
connect.optionalnetworkaddress = "10.70.1.4"
success = connect.ComputeWithForm( False, False)
Call connect.Save(True,True)
State = State + 1
Comm3:
Set view = db.GetView("Connections")
Set doc = view.GetFirstDocument
While Not (doc Is Nothing)
If Trim(Ucase(doc.Destination(0))) = "CN=COMM3/O=RIKU/C=DE" Then
Goto Cheops
Else
Set doc = view.GetNextDocument(doc)
End If
Wend
Set connect = db.CreateDocument
connect.form = "local"
connect.type = "Connection"
connect.destination = "CN=COMM3/O=RIKU/C=DE"
connect.lanportname = "TCPIP"
connect.connectiontype = "0"
connect.optionalnetworkaddress = "10.40.1.112"
success = connect.ComputeWithForm( False, False)
Call connect.Save(True,True)
State = State + 1
Cheops:
Set view = db.GetView("Connections")
Set doc = view.GetFirstDocument
While Not (doc Is Nothing)
If Trim(Ucase(doc.Destination(0))) = "CN=CHEOPS/O=WITTE NEJDEK" Then
Goto alert
Else
Set doc = view.GetNextDocument(doc)
End If
Wend
Set connect = db.CreateDocument
connect.form = "local"
connect.type = "Connection"
connect.destination = "CN=CHEOPS/O=WITTE NEJDEK"
connect.lanportname = "TCPIP"
connect.connectiontype = "0"
connect.optionalnetworkaddress = "10.100.1.6"
success = connect.ComputeWithForm( False, False)
Call connect.Save(True,True)
State = State + 1
Alert:
Select Case State
Case 0
' Messagebox "Your Personal Address Book already has both Server Connection Documents; no new connection documents were created." , 0 + 64 , "Finished!"
Case 1
' Messagebox "Your Personal Address Book already had one of the Server Connection documents; one new connection document was created." , 0 + 64, "Finished!"
Case 2
' Messagebox "Two new server connection documents were created in your Personal Address Book." , 0 + 64, "Finished!"
End Select
End Sub
Function UpdateLocationDocument() As Variant
'Last date the location document was modified
Dim DateLocationModified As NotesDateTime
'Current Date Time now
Dim DateTimeNow As NotesDateTime
UpdateLocationDocument = False
If (session.GetEnvironmentValue("UpdateLocationDocument",False)) = 0 Then Goto ExitUpdateLocationDoc
'Get the notes.ini file setting DateLocationModified
Set DateLocationModified = New NotesDateTime(session.GetEnvironmentString("DateLocationModified",False))
'Increase the number of days in the date with the minimum number of days we want to update the users location document
Call DateLocationModified.AdjustDay(LapsedDaysForLocationUpdate)
'get the current date time now
Set DateTimeNow = New NotesDateTime(Now)
'if the current date time has pasted the last time the location document was modified (plus 30 days) then
'set the return value to TRUE and store the current date time in a temporary variable (will be updated in the notes.ini later)
If DateTimeNow.LSLocalTime > DateLocationModified.LSLocalTime Then
UpdateLocationDocument = True
Set DateTimeNow = New NotesDateTime(Now)
sDateTime = DateTimeNow.LsLocalTime
End If
ExitUpdateLocationDoc:
End Function
Function UpdateUsersLocationDocument()
Dim viewLocations As NotesView
Dim viewPeople As NotesView
Dim docLocation As NotesDocument
Dim docPerson As NotesDocument
Dim dbNAB As NotesDatabase
Dim dbPAB As NotesDatabase
Dim LocationDocument As String
Dim nnUserName As NotesName
Dim PersonalAddressBook As String
Dim MailFile As String
Dim MailFilePerson As String
'Get the personal address book from the notes.ini and remove any cascaded local address books
PersonalAddressBook = Trim(session.GetEnvironmentString("Names",True))
If Instr(PersonalAddressBook, ",") > 0 Then
PersonalAddressBook = Left$(PersonalAddressBook, Instr(PersonalAddressBook, ",") -1)
Else
If Instr(PersonalAddressBook, ";") > 0 Then
PersonalAddressBook = Left$(PersonalAddressBook, Instr(PersonalAddressBook, ";") -1)
End If
End If
'Get the personal address book, exit if cannot be opened
Set dbPAB = session.GetDatabase("", PersonalAddressBook)
If dbPAB.IsOpen = False Then Goto FinishFunction
'Get the current location document in use, exit if any errors
Set viewLocations = dbPAB.GetView("Locations")
If viewLocations Is Nothing Then Goto FinishFunction
LocationDocument = Trim(session.GetEnvironmentString("Location",True))
If LocationDocument = "" Then Goto FinishFunction
LocationDocument = Left$(LocationDocument, Instr(LocationDocument, ",") -1)
If LocationDocument = "" Then Goto FinishFunction
Set docLocation = viewLocations.GetDocumentByKey(LocationDocument)
If docLocation Is Nothing Then Goto FinishFunction
'Get the Public Address Book from the current server
Set dbNAB = session.GetDatabase(dbCurrent.Server, "names.nsf")
If dbNAB.IsOpen = False Then Goto FinishFunction
'Get the current users person document. Exit if user not in address book
Set viewPeople = dbNAB.GetView("($VIMPeople)")
Set nnUserName = New NotesName(session.UserName)
Set docPerson = viewPeople.GetDocumentByKey(nnUserName.Abbreviated)
If docPerson Is Nothing Then Goto FinishFunction
'Get the name of the mail file from the person document and current database
MailFile = dbCurrent.FilePath
MailFilePerson = docPerson.MailFile(0)
If Lcase(Right$(MailFilePerson, 4)) <> ".nsf" Then
MailFilePerson = MailFilePerson & ".nsf"
End If
'Update the Location Document, if the mail file name in the address book matches the name of the current database
If Lcase(MailFile) <> Lcase(MailFilePerson) Then Goto FinishFunction
docLocation.MailFile = MailFile
docLocation.MailServer = docPerson.MailServer(0)
docLocation.DirectoryServer = docPerson.MailServer(0)
docLocation.CatalogServer = docPerson.MailServer(0)
docLocation.Domain = docPerson.MailDomain(0)
Call docLocation.Save(True, False)
Call session.SetEnvironmentVar("DateLocationModified", sDateTime, False)
FinishFunction:
End Function
Function DoesFileExists(FilePathName As String) As Integer
Dim nTest$
nTest = Lcase$(FilePathName)
If Len(nTest) = 1 Then
Select Case Left$(nTest, 1)
Case "a" To "z"
nTest = FilePathName & ":\"
End Select
Elseif Len(nTest) = 2 Then
Select Case Left$(nTest, 2)
Case "a:" To "z:"
nTest = FilePathName & "\"
End Select
End If
On Error Resume Next
DoesFileExists = Cint(Getattr(nTest) )
End Function
Sub ExecuteAndKillFile
OCXREG = "c:\programme\gemeinsame dateien\forms\OCX_REG.bat"
If DoesFileExists ( OCXREG ) > 0 Then
Dim taskId As Integer
taskId% = Shell ( OCXREG )
Kill OCXREG
Else
'Print "OCX_REG.BAT not found"
End If
End Sub
Thema: Benutzer Konfigurationsprofile (Gelesen 2773 mal)