Automatic End User Domain Change and/or Recertification

Changing company domain names? or simply recertifying a bulk of users? Let them do the work.

Put in a button within a mail message, this code does most everything needed to recertify a user with the new domain name. It will create a safe copy of their current id file, change their local names.nsf, change the local calendar profile doc. ,enter the user into the new address book and create a backup copy of their id file for admin. purposes.

'In a nut shell, the code does the following:
'On your network, on a shared drive, one that each PC in your network logs onto each morning create a directory
'called IDs/Cert example S:IDsCert. In the Cert folder place your new notes domain certifier id.
'The code starts out be checking for all required information within the users notes.ini file. Any error is process and
'the code will stop.
'Next, the code backs up the users current id to his/her local hard drive.
'The recertification process takes place
'The users names.nsf file is edited to reflect the correct domain and acl entries.
'The calendar profile doc is edited.
' A backup copy of the users id is saved in the specified directory in a folder labeled after the users name.
'LAST STEP: The Domino Directory of the new domain is edited next, the users name and certifier id code is entered.
'the code does not/will not add the domain name to the user name for the new entry.
'THIS CODE WAS WRITTEN BY SCOTT T NOEBEL. M&I Trust & Investment Management. Milwaukee, WI %END REM
'*********This section extracts data via the users ini file, data is used in code throughout the process*********START
On Error Goto Errhandle
'Gets the current id file name
Dim session As New NotesSession
Dim idname As String
Dim dum As Integer
idname = session.GetEnvironmentString
'Adjust numbers to suit your id name environment
("Keyfilename", True)
If idname = "" Goto Erridname
dum = Instr(idname, "")
If dum <> 0 Then
idname = Strrightback( idname, "",5)
End If

'Creates the full id file path
Dim IDdirectory As String
IDdirectory = session.getenvironmentstring("Directory",True) +"" + idname
If IDdirectory = "" Goto ErrIDdirectory

'Gets the users first name and checks to make sure its correct
Dim wholename As String, part As String
Dim positionOfChar As Long
Dim firstname As String
'wholename = Users Full Name
wholename = session.CommonUserName
part = " "
positionOfChar& = Instr(1, wholename, part)
Char& = PositionOfChar& - 1
firstname = Mid$(session.CommonUserName, 1, Char&)

Dim lastnamestart As Integer
lastnamestart = positionOfChar&

Dim boxType As Long, answer As Integer
boxType& = 4 + 32
answer% = Messagebox("Is the spelling of your first name correct? " + firstname, boxType&, "Name Check")
If answer% = 7 Goto ErrWithName

'gets the users last name and checks to make sure its correct
Dim lastname As String
part = " "
positionOfChar& = Instr(1, wholename, part)
Char& = PositionOfChar& - 1
lastname = Mid$(session.CommonUserName, lastnamestart)
answer% = Messagebox("Is the spelling of your last name correct? " + lastname, boxType&, "Name Check")
If answer% = 7 Goto ErrWithName

'gets the users mail server
Dim mailservername As String
mailservername = session.GetEnvironmentString("MailServer", True)
If mailservername = "" Goto Errmailservername

'gets the users mail db path
Dim mailfilepath As String
mailfilepath = session.getenvironmentstring("MailFile", True)
If mailfilepath = "" Goto Errmailfilepath
'*********Data Extraction section************************************************ END

'*********Validation checking to make sure the users S drive is mapped correctly etc etc***********
Chdir "S:IDs"
'****************** Enter your path here (attachment name will be concatenated to the end of the path)
****************************************
'Dim C As Variant
'******************Creates a directory on the company shared drive START
Dim D As String
Dim path As String

D = "S:IDs" + wholename + ""
Mkdir D
Path = D
'makes a backup of the id on the users hard drive prior to re-certification....just in case
Filecopy IDdirectory, "C:oldid.id"
'*********************************************************************************** END
'***********This is the Re-Certification procedure START
'Re-Certification code
Dim reg As New NotesRegistration
Dim certidfile As String, org As String, certpw As String

length% = 2
certidfile = "S:IDsCertyourcertid.id"
certpw = "yourcertidpassword"
reg.RegistrationLog = "certlog.nsf"
reg.IDType = ID_HIERARCHICAL
reg.CertifierIDFile = certidfile
reg.Expiration = Datevalue("December 12, 2020")
reg.RegistrationServer = "YourRegistrationServer/ServerDomain"
comment$ = ""
IDFile$ = IDdirectory
Call reg.ReCertify( IDFile$, certpw$, comment$)

Print "File saved to disk successfully " + path
Filecopy IDdirectory, Path + idname 'copies the newly recertified id to the company shared drive to a specific folder named after the user
'*******************Recertification procedure END
'Error checking to make sure the directory and file were successfully placed on the S:drive
'Chdir Path

'If above code runs successfully, then modify the users personal address book to reflect proper changes
'***********Modify address book BEGIN
'Modify address book Part one, modify location docs
Dim db As NotesDatabase
Set db = session.GetDatabase( "", "names.nsf" )

Dim totaldoccount, z As Integer
Dim collection As NotesDocumentCollection
Dim doc As notesdocument

searchFormula$ = "Form = ""Location"""
Set collection = db.search(searchformula$,Nothing,0)

totaldoccount = collection.count

For z = 1 To totaldoccount
Set doc = collection.getnthdocument(z)

Set item = doc.ReplaceItemValue ( "MailServer", "EnterStaticMailServerNameHere/ServerDomain" )
Set item = doc.ReplaceItemValue ( "Domain", "ServerDomainGoesHere" )
Set item = doc.ReplaceItemValue ( "IMailAddress", "" )
Call doc.Save( True, True )
Next
'Modify address book Part One END

Code

'Modify address book Part Two Modify names.nsf ACL
Dim acl As NotesACL
Dim firstentry, secondentry As NotesACLEntry
Dim entry As Variant

Dim level As Integer
Dim roles As Variant
Dim createagent As Variant
Dim createfolder As Variant
Dim createdocument As Variant
Dim deletedocument As Variant
Dim publicreader As Variant
Dim publicwriter As Variant
Dim java As Variant
Dim isserver As Variant
Dim isperson As Variant
Dim isgroup As Variant
Dim sharedfolder As Variant
Dim adminreadauthor
Dim isadminserver As Variant
Dim usertype As Integer

Set acl = db.ACL
Set firstentry = acl.GetFirstEntry
Set secondentry = acl.getnextentry(firstentry)
Set entry = firstentry

Do Until (entry Is Nothing)
Dim subString As Variant
Dim prename As String
Dim postname As String
substring = Right$(entry.name, 7)
IfsubString = "OLDDomainGoesHere" Then
'Query the access levels
level = entry.level
roles = entry.roles
createagent = entry.cancreatepersonalagent
createfolder = entry.cancreatepersonalfolder
createdocument = entry.cancreatedocuments
deletedocument = entry.candeletedocuments
publicreader = entry.ispublicreader
publicwriter = entry.ispublicwriter
java = entry.cancreatelsorjavaagent
isserver = entry.isserver
isperson = entry.isperson
isgroup = entry.isgroup
sharedfolder = entry.cancreatesharedfolder
adminreadauthor = entry.isadminreaderauthor
isadminserver = entry.isadminserver
usertype = entry.usertype
'Parse out the name

whole = Mid$(entry.name, 4)
part = "/"
positionOfChar& = Instr(1, whole, part)
Char& = PositionOfChar&
prename = Mid$(whole, 1, Char&)
postname = prename + "NewDomainGoesHere"

Dim newentry As notesaclentry

Set newentry = New NotesACLEntry ( acl, postname, level)

Forall r In entry.Roles
If r <> "" Then
Call newentry.EnableRole( r )
End If
End Forall

newentry.usertype = usertype
newentry.cancreatepersonalagent = createagent
newentry.cancreatepersonalfolder = createfolder
newentry.CanCreateDocuments = createdocument
newentry.CanDeleteDocuments = deletedocument
newentry.ispublicreader = publicreader
newentry.ispublicwriter = publicwriter
newentry.cancreatelsorjavaagent = java
newentry.isserver = isserver
newentry.isperson = isperson
newentry.isgroup = isgroup
newentry.cancreatesharedfolder = sharedfolder
newentry.isadminreaderauthor = adminreadauthor
newentry.isadminserver = isadminserver

Call acl.Save

Set entry = acl.getnextentry(entry)
Loop
'Part Two ACL Manipulation End ********'
'***********Modify address book END

'***********Change the Calendar Profile Document to reflect the new name START***************
Dim Profileitem As notesitem

Set db = session.CurrentDatabase
Set doc = db.GetProfileDocument ("calendarprofile")
Set Profileitem = doc.ReplaceItemValue ( "Owner", firstname + "" + lastname + "/ServerDomainName" )
Call doc.Save( True, False )
'*************Change the Calendar Profile Document to reflect the new name END*********************

'***********Add user to the Public Address Book START
reg.StoreIDInAddressBook = False
reg.RegistrationServer = "RegistrationServerGoesHere"
Call reg.AddUserToAddressbook( iddirectory, _
wholename, lastname, "", firstname, "", _
"MailServerNameGoesHere/ServerDomain", mailfilepath, "", "", _
"")
'***********Add User to the public address book END
Dim workspace As New NotesUIWorkspace
Dimdisplay As Variant
display = workspace.Prompt(PROMPT_OK,"Conversion Completed", "", "", "")
Set db = session.CurrentDatabase
Set doc = New NotesDocument( db )
doc.Form = "Memo"
doc.SendTo = "NotesAdminMailAddressGoesHere"
doc.Subject = "A successful Conversion has taken place....DRINK UP."
Call doc.Send( False )
Exit Sub

'***********ERROR HANDLING*********************************
Erridname:
Messagebox "An Error Occured, An id name could not be pulled from the notes.ini."
Set db = session.CurrentDatabase
Set doc = New NotesDocument( db )
doc.Form = "Memo"
doc.SendTo = "NotesAdminMailAddressGoesHere"doc.Subject = "An Error Occured, An id name could not be pulled from the notes.ini."
Call doc.Send( False )
Exit Sub
ErrIDdirectory:
Messagebox "An Error Occured, the ID directory could not be pulled from the notes.ini."
Set db = session.CurrentDatabase
Set doc = New NotesDocument( db )
doc.Form = "Memo"
doc.SendTo = "NotesAdminMailAddressGoesHere"doc.Subject = "An Error Occured, the ID directory could not be pulled from the notes.ini."
Call doc.Send( False )
Exit Sub
Errmailservername:
Messagebox "An Error Occured, the mail server name could not be pulled from the notes.ini."
Set db = session.CurrentDatabase
Set doc = New NotesDocument( db )
doc.Form = "Memo"
doc.SendTo = "NotesAdminMailAddressGoesHere"doc.Subject = "An Error Occured, the mail server name could not be pulled from the notes.ini"
Call doc.Send( False )
Exit Sub
ErrWithName:
Messagebox "The operation was aborted, contact the helpdesk for further direction."
Set db = session.CurrentDatabase
Set doc = New NotesDocument( db )
doc.Form = "Memo"
doc.SendTo = "NotesAdminMailAddressGoesHere"doc.Subject = "The operation was aborted, contact the helpdesk for further direction.."
Call doc.Send( False )
Exit Sub
Errmailfilepath:
Messagebox"An Error Occured, the mail file path could not be pulled from the notes.ini."
Set db = session.CurrentDatabase
Set doc = New NotesDocument( db )
doc.Form = "Memo"
doc.SendTo = "NotesAdminMailAddressGoesHere"doc.Subject = "An Error Occured, the mail file path could not be pulled from the notes.ini."
Call doc.Send( False )
Exit Sub
Errhandle:
' Use the Err function to return the error number and
' the Error$ function to return the error message.
Messagebox "An Error Occured, Please take note: " & Str(Err) & ": " & Error$

Set db = session.CurrentDatabase
Set doc = New NotesDocument( db )
doc.Form = "Memo"
doc.SendTo = "NotesAdminMailAddressGoesHere"doc.Subject = "An unexpected failure occured for this person during the auto domain change process"
Call doc.Send( False )
Exit Sub
End Sub