Utility to create tests in test plan of Quality Center

Problem: Create tests in the test plan by copying a base test in QC to a destination folder in QC with the test names from the file system's existing folders/files.

Solution: Created a macro using OTA to do the same:

Code:

Private Sub CommandButton1_Click()

    If LoadQCConnectForm Then
    End If

    Dim FSO As Object
    Dim Folder As Object
    Dim FolderName As String
    Dim SubFolder As Object
    Dim strTestCase As String
    Dim TestCaseName As String

    'Parent Directory - Change this to whichever directory you want to use
    FolderName = GetVariable("Fitnesse Path")

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(FolderName)

    For Each Folder In Folder.SubFolders
            TestCaseName = GetVariable("QC Fitnesse Path") & "." & Folder.Name
            Call TestPlanCopyPasteTest(GetVariable("QC Source"), GetVariable("QC Dest"), "BaseTest", TestCaseName)
            Call RebootQCCon
    Next Folder

    Set FSO = Nothing
    MsgBox "All Fitnesse tests created"

End Sub
###########################################################
'Module1
Option Explicit
Public Const SHT_VARIABLES = "variables"

'Function Name:     GetVariable
'Function Purpose: Returns the value of a variable
'Input Parameters: strVariableName - Name of the variable to lookup
'Output Parameters: None
'Return Value:      String containing the variable value
Function GetVariable(ByVal strVariableName As String) As String
    Dim n

    n = 2

    While Sheets(SHT_VARIABLES).Cells(n, 1) <> ""
        If Sheets(SHT_VARIABLES).Cells(n, 1) = strVariableName Then
            GetVariable = Sheets(SHT_VARIABLES).Cells(n, 2)
            Exit Function
        End If
        n = n + 1
    Wend

    MsgBox "Variable not found: " & strVariableName, vbCritical + vbOKOnly
End Function
'Function Name:     SetVariable
'Function Purpose: sets the value of a variable
'Input Parameters: strVariableName - Name of the variable to set
'                   strValue - value of the variable to set
Sub SetVariable(ByVal strVariableName As String, ByVal strValue As String)
    Dim n

    n = 2

    While Sheets(SHT_VARIABLES).Cells(n, 1) <> ""
        If Sheets(SHT_VARIABLES).Cells(n, 1) = strVariableName Then
            Sheets(SHT_VARIABLES).Cells(n, 2) = strValue
            Exit Sub
        End If
        n = n + 1
    Wend

    MsgBox "Variable not found: " & strVariableName, vbCritical + vbOKOnly
End Sub
###########################################################
'Module2

Option Explicit

Global tdc As TDConnection 'Global object storing the QC connection
Public QCConnected As Boolean

Public sHost 'stores the host name for the QC connection reboot
Public sDomain 'stores the domain for the QC connection reboot
Public sProject 'stores the project for the QC connection reboot
Public sUser 'stores the username for the QC connection reboot
Public sPassword 'stores the password for the QC connection reboot
Public sPort 'stores the port for the QC connection reboot

'Function Name: RebootQCCon
'Function Purpose: Resets the connection to Quality Center - required for some of our actions which are breaking due to QC bug that doesn't let us set filters
'Input Parameters: None
'Output Parameters:
'Return Value: Boolean - True or False
Public Sub RebootQCCon()
Call ConnectToQC(sHost, sDomain, sProject, sUser, sPassword, sPort)
End Sub

'Function Name: ConnectToQC
'Function Purpose: Makes the connection to Quality Center - taken from the OTA help reference
'Input Parameters: qcHostName$ - name of the qc server e.g "server085"
' qcDomain$ - Domain to connect to
' qcProject$ - QC project to connect to
' qcUser$ - QC username
' qcPassword$ - QC password
' qcPort - port to connect to
'Output Parameters:
Public Function ConnectToQC(qcHostName, qcDomain, qcProject, _
qcUser, qcPassword, Optional qcPort) As Boolean

QCConnected = False
On Error Resume Next
tdc.DisconnectProject
tdc.Disconnect
tdc.Logout
On Error GoTo 0

'Assign these to the private variables - useful if we need to reboot the QC connection
sHost = qcHostName
sDomain = qcDomain
sProject = qcProject
sUser = qcUser
sPassword = qcPassword
sPort = qcPort

'------------------------------------------------------------------------
' This routine makes the connection to the gobal TDConnection object
' (declared at the project level as Global tdc as TDConnection)
' and connects the user to the specified project.
'-----------------------------------------------------------------------
Dim qcServer As String
Dim errmsg As String
Const fName = "makeConnection" 'For error message

On Error GoTo makeConnectionErr
errmsg = ""

' Construct server argument using format:
' "http://server:port/qcbin"
qcServer = "http://" & qcHostName

If Not (IsMissing(qcPort)) Then
If Len(qcPort) > 0 Then qcServer = qcServer & ":" & qcPort
End If

qcServer = qcServer & "/qcbin"

' Check status (for demonstration purposes only).
' MsgBox tdc.LoggedIn 'Error: OTA Server is not connected
' MsgBox tdc.Connected 'False
' MsgBox tdc.ServerName 'Blank string
' Create the connection.
errmsg = "Failed to create TDConnection"
If (tdc Is Nothing) Then Set tdc = New TDConnection
If (tdc Is Nothing) Then GoTo makeConnectionErr
errmsg = ""
tdc.InitConnectionEx qcServer
' Check status.
' MsgBox tdc.LoggedIn 'False
' MsgBox tdc.Connected 'True
' MsgBox tdc.ServerName 'http:///qcbin/wcomsrv.dll


tdc.Login qcUser, qcPassword
' Check status.
' MsgBox tdc.LoggedIn 'True
' MsgBox tdc.ProjectName 'Empty String
' MsgBox tdc.ProjectConnected 'False
' Connect to the project and user.
tdc.Connect qcDomain, qcProject
ConnectToQC = True
QCConnected = True
Exit Function

makeConnectionErr:
ConnectToQC = False
MsgBox Err & " " & fName & " " & Err.Description & vbCrLf & errmsg

End Function

'Function Name: LoadQCConnectForm
'Function Purpose: Loads the Quality Center Connection Form
'Input Parameters: None
'Output Parameters:
'Return Value: True if the user connected to QC
Public Function LoadQCConnectForm() As Boolean

If Not ConnectToQC(GetVariable("QC Server"), GetVariable("QC Domain"), GetVariable("QC Project"), GetVariable("QC Username"), GetVariable("QC Password"), "") Then
Load QCConnect
QCConnect.Show
LoadQCConnectForm = QCConnected
Else
LoadQCConnectForm = True
End If
End Function
###########################################################
'Module3

'Function Name: TestPlanCopyPasteTest

'Function Purpose: Copies a test in the test plan (taken from the OTA documentation). Tweaked to actually work!!

'Input Parameters: strSourceFolderPath - source folder path to copy

' strDestFolderPath - destination to copy to

' strSourceTestName - name of test to copy

' strNewTestName - new name to give test

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

'Function Name: TestPlanCreateFolderStructure

'Function Purpose: Creates a Folder Structure in the Test Plan

'Input Parameters: strFullPath - Full Path of the Structure to Create e.g "Subject\A\B\C"

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

'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 Name: TestPlanDoesPathExist

'Function Purpose: Returns True if the path exists

'Input Parameters: strPath - Path in the test plan to search for

'Output Parameters: None

'Return Value: True or False

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

TestPlanDoesPathExist = False

Set TreeMgr = Nothing

Set SubjRoot = Nothing

Set SubjectNodeList = Nothing

Set oSubjectNode = Nothing

End Function

'Function Name: TestPlanDoesTestExist

'Function Purpose: Determines if a test exists in a certain location

'Input Parameters: strTestName - Name of the test to find e.g. "Test 001"

' strFolderToSearchPath - Name of the folder to search e.g. "Subject\Regression\Project A"

' SearchChildFolders - Set to true to look in child folders

' strTestType - The type of test to find, e.g. "QUICKTEST_TEST"

'Output Parameters: None

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

'Function Name: TestPlanFindTest

'Function Purpose: Searches for a test within a folder and returns it as a Test Object

'Input Parameters: strTestName - Name of the test to find e.g. "Test 001"

' strFolderToSearchPath - Name of the folder to search e.g. "Subject\Regression\Project A"

' SearchChildFolders - Set to true to look in child folders

' strTestType - The type of test to find, e.g. "QUICKTEST_TEST"

Function TestPlanFindTest(ByVal strTestName As String, ByVal strFolderToSearchPath As String, ByVal SearchChildFolders As Boolean, Optional ByVal strTestType As String, Optional blnSilentMode As Boolean) As Test

Dim oParentNode As SubjectNode

Dim SubjectNodeList As List

Dim oSubjectNode As SubjectNode

Dim intMatchCount As Integer: intMatchCount = 0

Dim TestFact As TestFactory

Dim oReturnValue As Test

Dim TestFilter As TDFilter

Dim TestList As List

Dim oTest As Test

Dim blnTypedMatched As Boolean: blnTypedMatched = True

Set oParentNode = TestPlanGetSubjectNode(strFolderToSearchPath)

Set TestFact = tdc.TestFactory

'If there was an error getting the parent node then exit

If (oParentNode Is Nothing) Then

Set TestPlanFindTest = Nothing

Exit Function

End If

'See if the parent folder has any tests that match the name we are looking for

Set TestFilter = TestFact.Filter

TestFilter.Filter("TS_SUBJECT") = Chr(34) & oParentNode.Path & Chr(34)

Set TestList = TestFact.NewList(TestFilter.Text)

For Each oTest In TestList

'Debug.Print "Test Name='" & oTest.Name & "' Test Type=" & oTest.Type

If (UCase(oTest.Name) = UCase(strTestName)) Then

'See if we should match the type - by default it is set to matched (true)

If (strTestType) <> "" Then

If (oTest.Type = strTestType) Then

blnTypedMatched = True

Else

blnTypedMatched = False

End If

If blnTypedMatched Then

intMatchCount = intMatchCount + 1

Set oReturnValue = oTest

End If

'Now check to see if we wanted to search child folders? If so search them

If SearchChildFolders Then

'Get all the child folders of the parent folder

Set SubjectNodeList = oParentNode.FindChildren("", False, "")

If Not (SubjectNodeList Is Nothing) Then

For Each oSubjectNode In SubjectNodeList

'Debug.Print oSubjectNode.Path

Set TestFilter = TestFact.Filter

TestFilter.Filter("TS_SUBJECT") = Chr(34) & oSubjectNode.Path & Chr(34)

Set TestList = TestFact.NewList(TestFilter.Text)

For Each oTest In TestList

'Debug.Print "Test Name='" & oTest.Name & "' Test Type=" & oTest.Type

If (UCase(oTest.Name) = UCase(strTestName)) Then

'See if we should match the type - by default it is set to matched (true)

If (strTestType) <> "" Then

If (oTest.Type = strTestType) Then

blnTypedMatched = True

Else

blnTypedMatched = False

End If

If blnTypedMatched Then

intMatchCount = intMatchCount + 1

Set oReturnValue = oTest

End If

'Clean Up

Set oParentNode = Nothing

Set SubjectNodeList = Nothing

Set oSubjectNode = Nothing

Set TestFact = Nothing

Set TestFilter = Nothing

Set TestList = Nothing

Set oTest = Nothing

'Now return a value

Select Case intMatchCount

Case 0

If Not blnSilentMode Then

MsgBox "Error: The Test could not be found with the parameters: " & Chr(10) & _

"Test Name:" & strTestName & Chr(10) & _

"Parent Folder Path:" & strFolderToSearchPath & Chr(10) & _

"Test Type:" & strTestType & Chr(10) & _

"Search child folders?:" & SearchChildFolders, vbExclamation + vbOKOnly, "TestPlanFindTest"

End If

Set TestPlanFindTest = Nothing

Case 1

Set TestPlanFindTest = oReturnValue

Case Else

If Not blnSilentMode Then

MsgBox "Error: A total of " & intMatchCount & " tests were found with the following criteria: " & Chr(10) & _

"Test Name:" & strTestName & Chr(10) & _

"Parent Folder Path:" & strFolderToSearchPath & Chr(10) & _

"Test Type:" & strTestType & Chr(10) & _

"Search child folders?:" & SearchChildFolders, vbExclamation + vbOKOnly, "TestPlanFindTest"

End If

Set TestPlanFindTest = Nothing

End Select

End Function

'Function Name: TestPlanGetSubjectNode

'Function Purpose: Returns a SubjectNode object for a given path in the Test Plan

'Input Parameters: strPath - Path in the test plan to return as a SubjectNode

Function TestPlanGetSubjectNode(ByVal strPath As String) As SubjectNode

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")

'Trim any trailing \

If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)

If UCase(strPath) = "SUBJECT" Then

Set TestPlanGetSubjectNode = SubjRoot

Set TreeMgr = Nothing

Set SubjRoot = Nothing

Exit Function

End If

Set SubjectNodeList = SubjRoot.FindChildren("", False, "")

For Each oSubjectNode In SubjectNodeList

If UCase(oSubjectNode.Path) = UCase(strPath) Then

Set TestPlanGetSubjectNode = oSubjectNode

Exit Function

End If

MsgBox "Test Plan path not found: " & strPath, vbExclamation + vbOKOnly, "TestPlanGetSubjectNode Error"

Set TestPlanGetSubjectNode = Nothing

Set TreeMgr = Nothing

Set SubjRoot = Nothing

Set SubjectNodeList = Nothing

Set oSubjectNode = Nothing

End Function

###########################################################
'Module4

Option Explicit

Public Type ScannedTreeItems

strKey As String

strParentKey As String

strValue As String

strFullQCPath As String

End Type

Public Enum QCPlanExplorerSelection

SelectAny = 0

SelectFolder = 1

SelectAnyTest = 2

SelectQTPTest = 3

End Enum

Public QCTestPlanItems() As ScannedTreeItems

Public QCTestPlanItemsInitialised As Boolean

Private gintKey As Integer

Public gItemSelectedPath As String 'stores the path of the item selected from the explorer userform

'Function Name: ResetQCTestPlanItems

'Function Purpose: Resets the data structures keeping track of the scanned test plan folders

'Input Parameters: None

'Modification Date:

Public Sub ResetQCTestPlanItems()

ReDim QCTestPlanItems(0)

QCTestPlanItemsInitialised = False

gintKey = 0

End Sub

'Function Name: ResetQCTestPlanItems

'Function Purpose: Increments and returns the unique key ID

'Input Parameters: None

Public Function GetNextKey() As Integer

gintKey = gintKey + 1

GetNextKey = gintKey

End Function

'Function Name: AddQCTestPlanItem

'Function Purpose: Inserts an item into the QCTestPlanItems datastructure. This will be read into the treeview so most of these

' attributes correlate to treeview attributes

'Input Parameters: strKey - Unique key for the item

' strParentKey - Key of the parent item that owns it

' strValue - Value of the node item

Public Sub AddQCTestPlanItem(strKey, strParentKey, strValue, strFullQCPath)

If QCTestPlanItemsInitialised Then

ReDim Preserve QCTestPlanItems(UBound(QCTestPlanItems) + 1)

QCTestPlanItems(UBound(QCTestPlanItems)).strKey = strKey

QCTestPlanItems(UBound(QCTestPlanItems)).strParentKey = strParentKey

QCTestPlanItems(UBound(QCTestPlanItems)).strValue = strValue

QCTestPlanItems(UBound(QCTestPlanItems)).strFullQCPath = strFullQCPath

Else

ReDim QCTestPlanItems(0)

QCTestPlanItems(0).strKey = strKey

QCTestPlanItems(0).strParentKey = strParentKey

QCTestPlanItems(0).strValue = strValue

QCTestPlanItems(0).strFullQCPath = strFullQCPath

QCTestPlanItemsInitialised = True

End If

End Sub

'Function Name: BuildTestPlan

'Function Purpose: Builds the data structure for the Test Plan. It iterates the folder contents and recursively calls itself.

'Input Parameters: strParentKey - Key of the parent owning

' strNodePath - QC Path of the Node to add to the datastructure

'Modification Date:

Public Sub BuildTestPlan(ByVal strParentKey As String, ByVal strNodePath As String)

Dim intUniqueKeyNo As Integer

Dim strThisKey As String

Dim oSubjectNode As SubjectNode

Dim ChildSubjectNodes As List

Dim oChildNode As SubjectNode

Dim strExpectedPath As String

Dim TestFact As TestFactory

Dim TestFilter As TDFilter

Dim TestList As List

Dim oTest As Test

Dim strTestKey As String

'Get the Subject Node

Set oSubjectNode = TestPlanGetSubjectNode(strNodePath)

If (oSubjectNode Is Nothing) Then Exit Sub

'Setup the key - Folders always have a key prefix of "f"

intUniqueKeyNo = GetNextKey

strThisKey = "f-" & intUniqueKeyNo

'Add this Folder into the datastructure

Call AddQCTestPlanItem(strThisKey, strParentKey, oSubjectNode.Name, strNodePath)

'Does it have any child folders?

Set ChildSubjectNodes = oSubjectNode.FindChildren("", False, "")

If Not (ChildSubjectNodes Is Nothing) Then

'This gives us a list of all children + subchildren so we need to filter it a bit

For Each oChildNode In ChildSubjectNodes

strExpectedPath = strNodePath & "\" & oChildNode.Name

If strExpectedPath = oChildNode.Path Then

'It's a direct child so iterate it

Call BuildTestPlan(strThisKey, strExpectedPath)

End If

'Now it's processed all the child folders, look to see if there are any tests

Set TestFact = tdc.TestFactory

Set TestFilter = TestFact.Filter

TestFilter.Filter("TS_SUBJECT") = Chr(34) & strNodePath & Chr(34)

Set TestList = TestFact.NewList(TestFilter.Text)

'Scan through all of the tests

For Each oTest In TestList

If (oTest.Type = "QUICKTEST_TEST") Then

'mark it as a QTP test ("q" prefix)

strTestKey = "q-" & GetNextKey

Call AddQCTestPlanItem(strTestKey, strThisKey, oTest.Name, strNodePath)

Else

'mark it as a normal test ("t" prefix)

strTestKey = "t-" & GetNextKey

Call AddQCTestPlanItem(strTestKey, strThisKey, oTest.Name, strNodePath)

End If

End Sub

###############################################################

To use the above code, copy the code into new modules respectively

Happy coding to test the code ;)

Search This Blog

Go gaga over Machine Learning

Utility to create tests in test plan of Quality Center

Comments

Post a Comment

Popular posts from this blog

Three amigios | CI - CD - Test Automation

Software Testing @ Microsoft

Trim / Remove spaces in Xpath?