QTP - Associate Object repository at run time in QTP

Methods
Add
Adds an object repository file to the specified position in the collection.
Find
Finds the position of the specified object repository file.
MoveToPos
Moves the object repository file entry from the current position to the specified new position.
Remove
Removes the object repository that is located in the specified position.
RemoveAll
Removes all object repository files from the collection.
SetAsDefault
Sets the object repository files associated with the current action as the default files for all new actions.




'************************************************************************************************************************


'Description:


'


'This example opens a test, configures an action's object repositories collection


'and saves the test.


'


'Assumptions:


'There is no unsaved test currently open in QuickTest.


'For more information, see the example for the Test.SaveAs method.


'************************************************************************************************************************





Dim qtApp 'As QuickTest.Application ' Declare the Application object variable


Dim qtRepositories 'As QuickTest.ObjectRepositories ' Declare an action's object repositories collection variable


Dim lngPosition





' Open QuickTest


Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object


qtApp.Launch ' Launch QuickTest


qtApp.Visible = True ' Set QuickTest to be visible





' Open a test and get the "Login" action's object repositories collection


qtApp.Open "C:\Tests\Test1", False, False ' Open a test


Set qtRepositories = qtApp.Test.Actions("Login").ObjectRepositories ' Get the object repositories collection object of the "Login" action





' Add MainApp.tsr if it's not already in the collection


If qtRepositories.Find("C:\MainApp.tsr") = -1 Then ' If the repository cannot be found in the collection


qtRepositories.Add "C:\MainApp.tsr", 1 ' Add the repository to the collection


End If





' If InnerWnd.tsr is moved down the list - place it back at position 1


If qtRepositories.Count > 1 And qtRepositories.Item(2) = "C:\InnerWnd.tsr" Then ' If there's more than one object repository and InnerWnd.tsr is in position 2


qtRepositories.MoveToPos 1, 2 ' Switch between the first two object repositories


End If





' If Debug.tsr is in the collection - remove it


lngPosition = qtRepositories.Find("C:\Debug.tsr") ' Try finding the Debug.tsr object repository


If lngPosition <> -1 Then ' If the object repository was found in the collection


qtRepositories.Remove lngPosition ' Remove it


End If





' Set the new object repository configuration as the default for all new actions


qtRepositories.SetAsDefault ' Set object repositories associated with the "Login" action as the default for all new actions





'Save the test and close QuickTest


qtApp.Test.Save ' Save the test


qtApp.Quit ' Quit QuickTest





Set qtRepositories = Nothing ' Release the action's shared repositories collection


Set qtApp = Nothing ' Release the Application object

'********************
'***************************


'The following example retrieves an object repository's objects and properties,


'looks for specific test objects using several methods, and copies a test object


'to another object repository.


'********************
'***************************
Dim ImageObj, PageObj, RepositoryFrom, RepositoryTo




Set RepositoryFrom = CreateObject("Mercury.ObjectRepositoryUtil")


Set RepositoryTo = CreateObject("Mercury.ObjectRepositoryUtil")




RepositoryFrom.Load "C:\QuickTest\Tests\Flights.tsr"


RepositoryTo.Load "E:\Temp\Tests\Default.tsr"


Function EnumerateAllChildProperties(Root)


'The following function recursively enumerates all the test objects directly under


'a specified parent object. For each test object, a message box opens containing the


'test object's name, properties, and property values.


Dim TOCollection, TestObject, PropertiesCollection, Property, Msg




Set TOCollection = RepositoryFrom.GetChildren(Root)




For i = 0 To TOCollection.Count - 1


Set TestObject = TOCollection.Item(i)


Msg = RepositoryFrom.GetLogicalName(TestObject) & vbNewLine


Set PropertiesCollection = TestObject.GetTOProperties()




For n = 0 To PropertiesCollection.Count - 1


Set Property = PropertiesCollection.Item(n)


Msg = Msg & Property.Name & "-" & Property.Value & vbNewLine


Next


MsgBox Msg




EnumerateAllChildProperties TestObject


Next




End Function




Function EnumerateAllObjectsProperties(Root)


'The following function enumerates all the test objects under a specified object.


'For each test object, a message box opens containing the test object's name,


'properties, and property values.


Dim TOCollection, TestObject, PropertiesCollection, Property, Msg




Set TOCollection = RepositoryFrom.GetAllObjects(Root)




For i = 0 To TOCollection.Count - 1


Set TestObject = TOCollection.Item(i)


Msg = RepositoryFrom.GetLogicalName(TestObject) & vbNewLine




Set PropertiesCollection = TestObject.GetTOProperties()


For n = 0 To PropertiesCollection.Count - 1


Set Property = PropertiesCollection.Item(n)


Msg = Property.Name & "-" & Property.Value & vbNewLine


Next




MsgBox Msg


Next




End Function




Function RenameAllImages(Root)


'The following function sets a new name for all image test objects under a specified object.


Dim TOCollection, TestObject, PropertiesCollection, Property




Set TOCollection = RepositoryTo.GetAllObjectsByClass("Image")




For i = 0 To TOCollection.Count - 1


Set TestObject = TOCollection.Item(i)


RepositoryTo.RenameObject (TestObject, "Image " & i)


RepositoryTo.UpdateObject TestObject


Next




End Function




Function RemoveAllLinks(Root)


'The following function recursively enumerates all the test objects under a specified object.


'It looks for all test objects of class Link and removes them from their parent objects.


Dim TOCollection, TestObject, PropertiesCollection, Property




Set TOCollection = RepositoryFrom.GetChildren(Root)




For i = 0 To TOCollection.Count - 1


Set TestObject = TOCollection.Item(i)


TOClass = TestObject.GetTOProperty("micclass")




If TOClass = "Link" Then


RepositoryFrom.RemoveObject Root, TestObject


End If




EnumerateAllChildProperties TestObject


Next




End Function