Hi, We have requirement to create test lab using workflow script. In script the loweset level folder in test plan is selected for filter and script is executed. It creates test lab folder structure same as test plan and creates test set for last folder in test plan and link all test case under that folder in test plan. If new test case is added in test plan we need to run the script again. If test case count is 2000 it takes around 10 mins to create. But some folder have 5000 test case and system becomes unresponsive. Is there anyway we can improve performance. QC server has 4 GB of RAM. Below is the script -
Sub BuildLab()
On Error Resume Next
'Preparation'
Dim startTime
startTime = Now
Set tdc = TDConnection
Set treemgr = tdc.treemanager
Set myTestFact = tdc.TestFactory
Set myTestFilter = myTestFact.Filter
'build filter regarding the last known folder'
myTestFilter.Filter("TS_SUBJECT") = "^\" & myFolderPath & "^"
Set myTestList = myTestFact.NewList(myTestFilter.Text)
'are you sure you want to copy?'
strMsg = myTestList.Count & " Test cases found!" & vbCRLF
strMsg = strMsg & "Copy for " & myFolderPath & " start?"
result = MsgBox (strMsg,vbYesNo,"Test Plan Copy to Lab?")
If result = vbNo Then
'no copy wanted
Exit Sub
End If
For Each actTest In myTestList
'Node of Subject-Folder
Set mySNode = actTest.Field("TS_Subject")
'Path of Subject-Folder [Subject\... (w/o Testname)]
myPath = mySNode.Path
'build testset and add testinstance
result = CreateLab(myPath,actTest)
Next 'Testcase
endTime = Now
MsgBox "Test Lab Created in " & (DateDiff("s",startTime,endTime)&" seconds"), vbOKOnly
Set myPath = Nothing
Set mySNode = Nothing
Set myTestList = Nothing
Set myTestFilter = Nothing
Set myTestFact = Nothing
Set treemgr = Nothing
Set tdc = Nothing
On Error GoTo 0
End Sub
Function CreateLab(CurrentPath, CurrentTest)
Dim tdcF
Dim TStmgr
Dim myRoot
Dim newTSTest
On Error Resume Next
'Preparation
Set tdcF = TDConnection
Set TStmgr = tdcF.TestSetTreeManager
'Split path for loop
subjectArray = Split(currentPath, "\")
'initialize variable for path
'Remember: Test Plan begins with Subject and Test Lab with Root!
NewPath = "Root"
OldPath = ""
'Begin loop
For idx = 1 To UBound(subjectArray)
'save path
OldPath = NewPath
'get new folder
CurrentSubName = subjectArray(idx)
'build new path
NewPath = Trim(NewPath) & "\" & CurrentSubname
'search Folder
Set newNode = TStmgr.NodeByPath(NewPath)
'create folder if it does not exist
If newNode Is Nothing Then
Set TStmgr = Nothing
Set TStmgr = tdcF.TestSetTreeManager
If idx = 1 Then
Set myRoot = TStmgr.Root
Else
Set myRoot = TStmgr.NodeByPath(OldPath)
End If ' idx'
Set newNode = myRoot.addNode(CurrentSubName)
newNode.post
End If 'new Node
'if the current folder is the last folder of the array
'create a testset (if necessary) and add the current test
If idx = UBound(subjectArray) Then
'Check: Does the testset exist?
'create a filter with Folder-id and -name
Set testSetF = newNode.TestSetFactory
Set testSetFilter = testSetF.Filter
testSetFilter.Filter("CY_FOLDER_ID") = NewNode.Nodeid
testSetFilter.Filter("CY_CYCLE") = CurrentSubName
Set TSList = testSetF.newList(testSetFilter.Text)
'Add Testset only if necessary
If TSList.Count = 0 Then
'nothing found'
Set testSet1 = testSetF.AddItem(Null)
testSet1.Name = CurrentSubName
testSet1.Status = "Open"
testSet1.Post
Else
'else get it
Set testSet1 = TSList.Item(1)
End If 'TSList
'Check: testinstance
'DO not use FindTestInstance (way too much overhead)
Set TSTestF = TestSet1.TSTestFactory
Set TSTestList = TSTestF.newList("")
'initialize marker
foundTS = 0
If TSTestList.Count > 0 Then
For Each myTSTest In TSTestList
If myTSTest.testId = Trim(CurrentTest.ID & " ") Then
foundTS = 1
End If
Next ' myTSTest
End If ' TSTestList
'Add Test if necessary :)
If foundTS = 0 Then
'nothing found => add test to testset
Set newTSTest = TSTestF.AddItem(CurrentTest.ID)
newTSTest.Post
End If ' foundTS
End If ' idx
'Cleanup for objects (just to be sure)
Set newTSTest = Nothing
Set myTSTest = Nothing
Set testSetFilter = Nothing
Set TSTestF = Nothing
Set TSTestList = Nothing
Set testSetFilter = Nothing
Set testSetF = Nothing
Set folder = Nothing
Set newNode = Nothing
Next 'idx
On Error GoTo 0
CreateLab = True
End Function