QC OTA - Test Plan - 1
Here are some amazing functions that can be reused wrt QC OTA for Test Plan module:
- Copy paste within Test Plan- Create folder structure within Test Plan
- Does a particular path exist in Test Plan
- Does a [particular test exist in Test Plan
Function TestPlanCopyPasteTest(strSourceFolderPath, strDestFolderPath, strSourceTestName, strNewTestName) As Boolean
'Copy a test, including design steps and parameters.
' For example:
' CopyPasteTest "Subject\TestFolder1", "Subject\TestFolder2", "Test1"
' Copies Test1 to TestFolder2
Dim sourceFolder As SubjectNode
Dim destFolder As SubjectNode
Dim treeMng As TreeManager
Dim iscp As ISupportCopyPaste
Dim clipboard As String
Dim oSourceTest As Test
Dim oNewTest As Test
'Check that the source file exists
If Not TestPlanDoesTestExist(strSourceTestName, strSourceFolderPath, False, "") Then
TestPlanCopyPasteTest = False
MsgBox "Source test does not exist: " & strSourceFolderPath & "\" & strSourceTestName, vbExclamation + vbOKOnly, "TestPlanCopyPasteTest"
Exit Function
End If
'Check that the destination test does not exist
If TestPlanDoesTestExist(strNewTestName, strDestFolderPath, False, "") Then
TestPlanCopyPasteTest = False
MsgBox "Destination test already exists: " & strDestFolderPath & "\" & strNewTestName, vbExclamation + vbOKOnly, "TestPlanCopyPasteTest"
Exit Function
End If
'On Error GoTo errCondition
Set sourceFolder = TestPlanGetSubjectNode(strSourceFolderPath)
Set testF = sourceFolder.TestFactory
' Find the test ID.
Set oSourceTest = TestPlanFindTest(strSourceTestName, strSourceFolderPath, False, "", True)
' Copy the source test.
Set iscp = testF
clipboard = iscp.CopyToClipBoard(oSourceTest.ID, 0, "")
' Paste the test in the destination folder.
Set destFolder = TestPlanGetSubjectNode(strDestFolderPath)
Set testF = destFolder.TestFactory
Set iscp = testF
iscp.PasteFromClipBoard clipboard, destFolder.NodeID
'Now it's pasted, rename it
'Reboot the QC connection as we get some failures around this point
Call RebootQCCon
Set oNewTest = TestPlanFindTest(strSourceTestName, strDestFolderPath, False, "")
oNewTest.Name = strNewTestName
oNewTest.Post
' Clean up.
Set iscp = Nothing
Set treeMng = Nothing
Set sourceFolder = Nothing
Set destFolder = Nothing
Set oNewTest = Nothing
Set oSourceTest = Nothing
TestPlanCopyPasteTest = True
Exit Function
errCondition:
MsgBox "Error: " & Err.Description, vbExclamation + vbOKOnly, "TestPlanCopyPasteTest"
TestPlanCopyPasteTest = False
End Function
-----------------------------------------------------
Sub TestPlanCreateFolderStructure(strFullPath)
Dim arrFolders() As String
Dim n As Integer
Dim strParentPath As String
Dim strThisPath As String
Dim oParentFolder As SubjectNode
'First of all, does the folder structure already exist?
If TestPlanDoesPathExist(strFullPath) Then Exit Sub
'Now split the path up into its individual folders
arrFolders = Split(strFullPath, "\")
'does the first element contain subject? if not, exit
If UCase(arrFolders(0)) <> "SUBJECT" Then
MsgBox "Error: The first element in the folder path must be 'Subject'", vbExclamation + vbOKOnly, "TestPlanCreateFolderStructure"
Exit Sub
End If
'iterate the array
For n = 0 To UBound(arrFolders)
'Create the folder if it doesn't exist
If strParentPath <> "" Then
strThisPath = strParentPath & "\" & arrFolders(n)
Debug.Print "strThisPath=" & strThisPath
'Does this path exist? If not we need to create it
If (TestPlanDoesPathExist(strThisPath) = False) And (arrFolders(n) <> "") Then
'Create it
'Get the parent folder
Set oParentFolder = TestPlanGetSubjectNode(strParentPath)
'Create this folder underneath it
oParentFolder.AddNode (arrFolders(n))
End If
End If
'before we move on, set the parent path
If strParentPath = "" Then
strParentPath = "Subject"
Else
strParentPath = strThisPath
End If
Next n
'Release all objects
Set oParentFolder = Nothing
End Sub
-------------------------------------------------------
Function TestPlanDoesPathExist(ByVal strPath As String) As Boolean
Dim TreeMgr As TreeManager
Dim SubjRoot As SubjectNode
Dim SubjectNodeList As List
Dim oSubjectNode As SubjectNode
Set TreeMgr = tdc.TreeManager
Set SubjRoot = TreeMgr.TreeRoot("Subject")
If UCase(strPath) = "SUBJECT" Then
TestPlanDoesPathExist = True
Exit Function
End If
Set SubjectNodeList = SubjRoot.FindChildren("", False, "")
For Each oSubjectNode In SubjectNodeList
If UCase(oSubjectNode.Path) = UCase(strPath) Then
TestPlanDoesPathExist = True
Set TreeMgr = Nothing
Set SubjRoot = Nothing
Set SubjectNodeList = Nothing
Set oSubjectNode = Nothing
Exit Function
End If
Next
TestPlanDoesPathExist = False
Set TreeMgr = Nothing
Set SubjRoot = Nothing
Set SubjectNodeList = Nothing
Set oSubjectNode = Nothing
End Function
----------------------------------------------------
Function TestPlanDoesTestExist(ByVal strTestName As String, ByVal strFolderToSearchPath As String, ByVal SearchChildFolders As Boolean, Optional ByVal strTestType As String) As Boolean
Dim oTempTest As Test
Set oTempTest = TestPlanFindTest(strTestName, strFolderToSearchPath, SearchChildFolders, strTestType, True)
If (oTempTest Is Nothing) Then
TestPlanDoesTestExist = False
Else
TestPlanDoesTestExist = True
End If
Set oTempTest = Nothing
End Function
---------------------------------------------------
Comments
Post a Comment