Clean Rename of domain and organization name in calendar

Notes community,

We have already merged parts of two Domino domains into one new domain.

With the adminP process the organization move and rename request did not work properly in some particular cases.

We noticed that some fields (like RequiredAttendees, RestrictAttendence, OptionalAttendees) in calendar of our users were not renamed by adminP in generally.

Even, also some name values in “chair”, “from” and “principal” fields were not renamed properly but just in some particular cases.

We reprocessed all rename requests in adminP but without success.

We already have contacted IBM support for getting a sample lotus script for renaming all changed names and addresses in all necessary fields of calendar documents. Unfortunately, without a satisfied answer (as usual).

IBM support did recommend to set administration server in mail database’s ACL for change all name fields.

My meaning is that we will get problems with this setting because this setting will also match the case of delete a user from Domino directory. What do you think about?

I already created an agent (quick and dirty) in mail template for renaming name values in every calendar entry. It seems that this script works fine but had not the time for testing it in all possible cases. What do you think about? Maybe, you could provide me additional tips and hints for optimizing it.

Thank you for your input!

Have fun!

Arno

Sample script (agent) for rename names in calendar. (This agent should be run just by mail database owner)

Sub Initialize

On Error Goto Errhandle

	

'Please note:  This sample script is to be used as is and at your own risk!



Dim session As New NotesSession



	

Dim strSubject As String

Dim strSubject2 As String



Dim DDdb As NotesDatabase		'Domino Directory

Dim viewDD As NotesView		'Domino Directory view for lookup names



Dim maildatabase As NotesDatabase 	'Users Mail Database

Dim viewCal As NotesView		'Calendar View

Dim CalDoc As NotesDocument	 'Calendar Parent Document

Dim CalEntryCol As NotesViewEntryCollection

Dim Entry As NotesViewEntry

Dim CalRCol As NotesDocumentCollection  'Calendar Children DocCollection

Dim CalRDoc As NotesDocument 'Calendar Children Doc	



Set maildatabase = session.CurrentDatabase

Set DDdb = session.GetDatabase(maildatabase.server,"names.nsf")



If DDdb.IsOpen Then  'Open DD and check if it's open

	Set viewDD = DDdb.GetView("($Users)")	 'Get Lookup View

Else

	Exit Sub

End If



If maildatabase.IsOpen Then

	

	Set viewCal = maildatabase.GetView("Meetings")

	

	Set CalEntryCol = viewCal.AllEntries

	Set Entry = CalEntryCol.GetFirstEntry

	

	Do Until Entry Is Nothing

		

		Set CalDoc = Entry.Document

		

		If CalDoc.ParentDocumentUNID = "" Then			

			'strSubject = CalDoc.Subject(0)

			Call CheckAndUpdateNames(CalDoc,viewDD)

			

			Set  CalRCol = CalDoc.Responses

			

			If CalRCol.count > 0 Then

				Set CalRDoc = CalRCol.GetFirstDocument

				Do Until CalRDoc Is Nothing

					'strSubject2 = CalRDoc.Subject(0)

					Call CheckAndUpdateNames(CalRDoc,viewDD)

					Set CalRDoc = CalRCol.GetNextDocument(CalRDoc)

				Loop			

			End If				

		End If

		

		Set Entry = CalEntryCol.GetNextEntry(Entry)

		

	Loop

%REM

	Set EnvDoc = EnvCol.GetFirstDocument

	

	Do Until EnvDoc Is Nothing

		If EnvDoc.Form(0) = "frmClientInfo" Then

			Call EnvDoc.ReplaceItemValue("DateTime_Rename",Now)

			Call EnvDoc.Save(True,False)

		End If

		Set EnvDoc = EnvCol.GetNextDocument(EnvDoc)

	Loop

%END REM

End If

exit_handler:

Exit Sub

Errhandle:

Print "Error " & Err & ": " & Error$ & " encountered at line " & Erl & " of " & Getthreadinfo(1) & "."



Resume Next

End Sub

Sub CheckAndUpdatenames(CalDoc As NotesDocument, viewDD As NotesView)

On Error Goto Errhandle

Dim DDdoc As NotesDocument   'Person Document in Domino Directory

Dim NameValues As Variant	     'Current Field Values

Dim LookupName As String		'Name Value for Lookup in Domino Directory

Dim nam As NotesName			'Name Value Object for getting Abbrevaiate Names

Dim AbbrevaiateName As String  'Abbrevaiate Name for creating Notes mail address



Dim Fieldnames(0 To 9) As String    'Check following fields in calendar entries

Fieldnames(0) = "$BusyName"  

Fieldnames(1) = "AltChair"

Fieldnames(2) = "AltRequiredNames"

Fieldnames(3) = "Chair"

Fieldnames(4) = "From"

Fieldnames(5) = "Principal"

Fieldnames(6) = "Recipients"

Fieldnames(7) = "RequiredAttendees"

Fieldnames(8) = "RestrictAttendence"

Fieldnames(9) = "OptionalAttendees"





' Check just name values with the following domains and organizations	

Dim OldOrg(0 To 3) As String	

OldOrg(0) = "/O=Org1"

OldOrg(1) = "/Org"

OldOrg(2) = "/OU=OUnit2/O=Org2"

OldOrg(3) = "/OUnit2/Org2"



Dim OldDomain(0 To 1) As String	

OldDomain(0) = "@OldDomain1"

OldDomain(1) = "@OldDomain2"





' Switches

Dim WriteArrayToCalendar As Boolean 'replace field values necessary

Dim CheckNameval As Boolean  'Lookup in DD necessary

Dim SaveCalendarDoc As Boolean 'save calendar document necessary



Dim i_NV As Integer	'Name Value Array counter

Dim i_FN As Integer	'Field Array counter





SaveCalendarDoc = False



i_FN = 0

Forall namevar In Fieldnames

	NameValues = CalDoc.GetItemValue(Fieldnames(i_FN))

	i_NV = 0

	If NameValues(0) = "" Then Goto NextField

	

	WriteArrayToCalendar = False

	Forall Nameval In NameValues

		CheckNameval = False

		

		Forall OOval In OldOrg

			If Instr(Nameval,OOval)  <> 0  Then

				CheckNameval = True

				Goto CheckNameval

			End If							

		End Forall

		

		Forall ODval In OldDomain

			If Instr(Nameval,ODval)  <> 0  Then

				CheckNameval = True

				Goto CheckNameval

			End If							

		End Forall

CheckNameval:

		If CheckNameval Then 'if name matches filter (Domain and/or Organization)

			

			If Instr(Nameval,"@") <> 0 Then

				Set nam = New NotesName(Strleft(Nameval,"@"))	

			Else

				Set nam = New NotesName(Nameval)								

			End If

			

			LookupName = nam.Abbreviated

			

			Set DDdoc = viewDD.GetDocumentByKey(LookupName)

			

			If Not DDdoc Is Nothing Then

				If Instr(Nameval,"/O=") <> 0 Then 'Canonical name

					Redim Preserve NameValuesNew(i_NV)

					NameValuesNew(i_NV) =  DDdoc.FullName(0)						

				Elseif Instr(Nameval,"/") <> 0 And Instr(Nameval,"@") <> 0 Then 'Mail address

					Redim Preserve NameValuesNew(i_NV)

					Set nam = New NotesName(DDdoc.FullName(0))

					AbbrevaiateName = nam.Abbreviated

					NameValuesNew(i_NV) = AbbrevaiateName & "@" & DDdoc.MailDomain(0)

				Elseif Instr(Nameval,"/") <> 0 And Not Instr(Nameval,"@") <> 0 Then 'Abbervaiate name

					Redim Preserve NameValuesNew(i_NV)

					Set nam = New NotesName(DDdoc.FullName(0))

					AbbrevaiateName = nam.Abbreviated	

					NameValuesNew(i_NV) = AbbrevaiateName							

				Else 'something else

					Redim Preserve NameValuesNew(i_NV)

					NameValuesNew(i_NV) = Nameval							

				End If

			Else

				Redim Preserve NameValuesNew(i_NV)

				NameValuesNew(i_NV) = Nameval							

			End If

		Else

			Redim Preserve NameValuesNew(i_NV)

			NameValuesNew(i_NV) = Nameval				

		End If

		

		If NameValuesNew(i_NV) <> Nameval Then  'Check if new value is different

			WriteArrayToCalendar = True

		End If

		

		i_NV = i_NV  + 1

	End Forall

	

	If WriteArrayToCalendar Then

		Call CalDoc.ReplaceItemValue(namevar,NameValuesNew)			

		SaveCalendarDoc = True			

	End If

NextField:

	i_FN = i_FN + 1

End Forall			



If SaveCalendarDoc Then

	Call CalDoc.Save(False,False,True)

End If

exit_handler:

Exit Sub

Errhandle:

Print "Error " & Err & ": " & Error$ & " encountered at line " & Erl & " of " & Getthreadinfo(1) & "."



Resume Next

End Sub