How can I update Share Object Repository (SOR) attributes in QTP using AOM?

  • Questions
  • How can I update Share Object Repository (SOR) attributes in QTP using AOM?
Question ID: 104700

I have serveral Shared object repositories that need attributes updated and was wondering if there is a way to do it using QTP Automation Object Model. Question: [How can i update several objects attibutes in local Objet Repository (LOR) in QTP?][1] works with Local Object Repository (LOR) and I need to update SOR. Anybody done this?


Marked as spam
Posted by (Questions: 17, Answers: 5)
Asked on November 14, 2012 11:44 am
Answers (2)
Private answer

Here is code I have used in the past that could help.

Dim TOCollection
Dim Msg
Dim RepositoryFrom
Dim TestObject
Dim ln, cn
Dim PropertiesCollection
Dim Property

Set RepositoryFrom = CreateObject(''Mercury.ObjectRepositoryUtil'')
RepositoryFrom.Load ''z:SORMySOR.tsr'' 
' Write your OR path here 

Set TOCollection = RepositoryFrom.GetAllObjectsByClass(''WebEdit'') 

For i = 0 To TOCollection.Count - 1
'print i &''#####################''   & i
	Set TestObject = TOCollection.Item(i)
	ln = RepositoryFrom.GetLogicalName(TestObject)
	cn = TestObject.GetTOProperty(''name'')
'print ''ln ='' & ln & ''     '' & cn
	If cn = ''WebEdit'' Then
		Set PropertiesCollection = TestObject.GetTOProperties()
		For n=0 To PropertiesCollection.Count - 1
			Set Property = PropertiesCollection.Item(n)
			Msg = Msg & Property.Name & ''-'' & Property.Value & vbNewLine
			If Property.Name = ''html id'' Then
				idArray = Split(Property.Value, ''d'')
				Msg2 = idArray(0) & '' - '' & idArray(1) & vbNewLine
				newId = idArray(0) & ''d_WIN_0_ '' & idArray(1) 
				'TestObject.SetTOProperty Property.Value, newId
				TestObject.SetTOProperty ''html id'',newId
				RepositoryFrom.UpdateObject TestObject
				Msg3 = Msg & ''New ID - '' & Property.Name & ''-'' & Property.Value & vbNewLine
			End If
'print cn & vbnewline & ln &vbnewline & Msg3 & VBnewline & ''Desired ID - '' & newId & VBnewline & VBnewline
	End If

msgbox ''Saved''

Set Property = nothing
Set PropertiesCollection = nothing
Set TestObject = nothing
Set TOCollection = nothing
Set RepositoryFrom =nothing

Marked as spam
Posted by (Questions: 2, Answers: 98)
Answered on November 14, 2012 11:50 am
Private answer

'This script uses an excel sheet to get a list of local object repositories and then updates them based on the object class and property
'To create the script copy and paste this into notepad and save as a .vbs file
'To run the script click the widnows button and type cmd in the search. In the command prompt paste the following:WScript.exe /E:VBSCRIPT [name of sript].vbs and hit enter

'Turn on error handling
On Error Resume Next

Dim RepositoryFrom, ToCollection, ToCollectionP, TestObject, cn, OrArrPath(), OrPath, xlApp, xlWorkBook, xlWorkSheet, ExlRwCnt, ArrSize, ArrSet

'create a new instance of the excel application
Set xlApp = CreateObject (''Excel.Application'')

'make it visible
xlApp.Visible = True

'open the excel file to feed the report paths ie (''C:excelfilename.xls'')
'The values in the excel file should be the full path without any parenthesis
'ie c:[Report Path]Action1ObjectRepository.bdb
Set xlWorkBook = xlApp.Workbooks.Open (''C:excelfilename.xls'')

'set the worksheet
Set xlWorkSheet = xlApp.ActiveWorkBook.WorkSheets(''Sheet1'')

'Use Evaluate function to determine how many rows have a non- blank values
ExlRwCnt = xlWorkSheet.Evaluate(''COUNTA(A:A)'')

'Get the count in the excel worksheet and subtract one to set the array
ArrSize = ExlRwCnt -1

'Set the size of the array
ReDim OrArrPath(ArrSize)

'Set the array counter in order to begin setting each point in the array
ArrSet = 0

'Cycle through each path and update each object in that path
For z = 1 to ExlRwCnt

'Get excel sheet value
Set OrArrPath(ArrSet) = xlWorkSheet.Cells(z,1)

'add a value to the arrsize variable to set the next position
ArrSet =ArrSet +1


'Reset the array counter to update each object
ArrSet = ArrSet -1

'Update all of the object repositories
For x = 0 To ArrSet

'Set the ObjectRepositoryUtil
Set RepositoryFrom = CreateObject(''Mercury.ObjectRepositoryUtil'')

'Grab the first object repository path from the array. Note this probably could be assigned directly from the array.
OrPath = OrArrPath(x)

'Load the path to the ObjectRepositoryUtil
RepositoryFrom.Load OrPath

'If there is an error catch it display it in a message box and exit the script
If Err.Number <> 0 Then
WScript.Echo ''Error: '' & Err.Number
WScript.Echo ''Error (Hex): '' & Hex(Err.Number)
WScript.Echo ''Source: '' & Err.Source
WScript.Echo ''Description: '' & Err.Description
Exit For
End If

'Grab all of the objects with a class ie ''Window''
Set ToCollection = RepositoryFrom.GetAllObjectsByClass(''Window'')

'For each attribute in the collection of objects
For i = 0 To ToCollection.Count - 1

'Grab the object
Set TestObject = ToCollection.Item(i)

'Get the value of this object attribute
cn = TestObject.GetTOProperty(''regexpwndclass'')

'If the value matches then set it to the new attribute
If cn = ''FNWND3120'' Then
TestObject.SetTOProperty ''regexpwndclass'',''FNWND3125''
End If

'save the object in the object repository
RepositoryFrom.UpdateObject TestObject

'save the Object Repository


'save object Repository

'Clear the variables/destroy them
Set RepositoryFrom =nothing
Set ToCollection = nothing
Set ToCollectionP=nothing
Set TestObject = nothing
Set cn =nothing
Set OrPath = nothing
Set ExlRwCnt = nothing
Set ArrSize = nothing
Set ArrSet = nothing

'Close the workbook and terminate our instance of excel

'Clear excel variables/destroy them
Set xlWorkSheet = Nothing
Set xlWorkBook = Nothing
Set xlApp = Nothing

'Notify the user the script is finished
msgbox(''Update Finished'')

Marked as spam
Posted by (Questions: 0, Answers: 2)
Answered on November 14, 2012 1:45 pm