Hat mit kleinen Anpassungen des Scripts einwandfrei funktioniert. Vielen Dank
Gruß
ajo
Function UpdateUsersLocationDocument()
Dim session As New NotesSession
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
Dim dbCurrent As NotesDatabase
Set dbCurrent = session.CurrentDatabase
Dim DateTimeNow As NotesDateTime
Set DateTimeNow = New NotesDateTime(Now)
Dim sDateTime As String
sDateTime = DateTimeNow.LsLocalTime
'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)
'Set dbPAB = session.GetDatabase("", "names.nsf")
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)
docLocation.ImailAddress = docPerson.InternetAddress(0)
Call docLocation.Save(True, False)
Call session.SetEnvironmentVar("DateLocationModified", sDateTime, False)
FinishFunction:
End Function