01-28-2014, 09:15 AM
Ans1: Yes It's possible. Below is the code, save the code as .vbs file and proceed.
Step 2:Yeah, provided you take care of the relative paths and place the necessary in the specific location.
Step3: I don't have any idea on this right now... But, I have built one few years back for my own using simple excel and db.
Let me know if you are still looking for any more information.
Code:
Option Explicit
'==========================================================================
'
' Quality Center QTP Test Case Exporter
'
' NAME: DownloadQTPFromQC.vbs
'
' AUTHOR: Sridhar Upputuri
' DATE : 4/4/2009
'
'
' PURPOSE:
' To export all QTP Test Cases from QC for a give Test Plan Root Node.
'
'==========================================================================
Dim wscript
set wscript=CreateObject ("wscript.shell")
'Quality Center Server settings
Dim strUserName, strPassword, strServer
strUserName = "User Name" '<-- Change me.
strPassword = "User Password" '<-- Change me.
strServer = "your QC URL"<-- Change me.
'Quality Center Project settings
Dim strDomain, strProject, strRootNode
strDomain = "Domain Name" '<-- Change me.
strProject = "Project Name" '<-- Change me.
strRootNode = "Path of the folder in which your scripts are present"'Subject\SAM 3.1.0 Automated Tests\SAM-QTP_Automation_AGE\Scripts\Home\" '<-- Change me.
'Return the TDConnection object.
Dim QCConnection
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
'Login to Quality Center
QCConnection.InitConnectionEx strServer
QCConnection.Login strUserName, strPassword
If (QCConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
WScript.Quit
End If
'Connect to Project
QCConnection.Connect strDomain, strProject
'Get array of user created TestClass objects
Dim arrObjQTPTests
arrObjQTPTests = GetQTPTestsFromQC(strRootNode)
'Close Quality Center Connection
QCConnection.Disconnect
QCConnection.Logout
QCConnection.ReleaseConnection
Set QCConnection = Nothing
'Create QTP object to control QTP
Dim qtApp
Set qtApp = CreateObject("QuickTest.Application")
'If connection not already established then establish connection(QTP already running)
If Not qtApp.TDConnection.IsConnected Then
qtApp.TDConnection.Connect strServer, strDomain, strProject, strUserName, strPassword, False
End If
qtApp.Launch ' Start QuickTest
qtApp.Visible = False ' Make the QuickTest application invisible
'Get each QTP test's name and path to load and save.
Dim objQTPTest
For Each objQTPTest In arrObjQTPTests
If qtApp.TDConnection.IsConnected Then ' If connection is successful
Dim strQCTestPath, strLocalTestPath, strLocalTestFolder
strQCTestPath = "[QualityCenter] " & objQTPTest.Path & "\" & objQTPTest.Name
strLocalTestPath = "C:\" & objQTPTest.Path & "\" & objQTPTest.Name
strLocalTestFolder = "C:\" & objQTPTest.Path
WScript.PopUP "Open test from QC: " & strQCTestPath,3,"Test Opened",0+32
qtApp.Open strQCTestPath, True ' Open test in read only mode
WScript.Popup "Create local folder: " & strLocalTestFolder,3,"Folder Created",0+32
CreateFolderPath(strLocalTestFolder) ' Create folder including parent folders.
WScript.Popup "Save Test as: " & strLocalTestPath & vbcrlf ,3,"Test Saved",0+32
qtApp.Test.SaveAs strLocalTestPath ' Save test to local path.
Else
MsgBox "Cannot connect to Quality Center" ' If connection is not successful, display an error message.
End If
Next
qtApp.TDConnection.Disconnect ' Disconnect from Quality Center
qtApp.Quit ' Exit QuickTest
Set qtApp = Nothing
'-----------------------------
' Function Library
'-----------------------------
'Gets the name and path of QTP tests for the give node in QC's Test Plan Module.
'
'@param: strRootNode Root Node in a Test Lab tree.
'
'@return: Object Array Array of TestClass objects for the given QC Node and subnodes.
'*
Public Function GetQTPTestsFromQC (ByVal strRootNode)
'Gets subnodes of the given root node.
Dim arrStrNodesList
arrStrNodesList = GetNodesList(strRootNode)
Dim arrObjQTPTest(), intNewUpper
intNewUpper = 0
'Get all QTP test for each of the given nodes in the node list.
Dim strNode
For Each strNode In arrStrNodesList
Dim objTreeManager, objSubjectNode, objTestFactory, objTDFilter
Set objTreeManager = QCConnection.TreeManager
Set objSubjectNode = objTreeManager.NodeByPath(strNode)
Set objTestFactory = objSubjectNode.TestFactory
Set objTDFilter = objTestFactory.Filter
' objTDFilter("TS_TYPE") = "= 'QUICKTEST_TEST'"
Dim objTestList
Set objTestList = objTestFactory.NewList(objTDFilter.Text)
'Get the name and path for each of the QTP tests in the test list.
Dim objTest
For Each objTest In objTestList
ReDim Preserve arrObjQTPTest(intNewUpper)
Set arrObjQTPTest(intNewUpper) = New TestClass
'Create a TestClass to make setting and getting the path and name easier.
arrObjQTPTest(intNewUpper).Path = objSubjectNode.Path
arrObjQTPTest(intNewUpper).Name = objTest.Name
intNewUpper = intNewUpper + 1
Next
Next
'Cleanup objects
Set objTest = Nothing
Set objTestList = Nothing
Set objTDFilter = Nothing
Set objTestFactory = Nothing
Set objSubjectNode = Nothing
Set objTreeManager = Nothing
GetQTPTestsFromQC = arrObjQTPTest
End Function
'Returns an array for all children of a given Node of a tree.
'
'@param: RootNode strNode in a Test Lab tree.
'
'@return: String Array Array of subnodes paths for the given QC root node.
'*
Public Function GetNodesList(ByVal RootNode)
'Specify Array to contain all nodes of subject tree.
Dim arrStrNodesList()
ReDim Preserve arrStrNodesList(0)
arrStrNodesList(0) = RootNode
Dim objTreeManager, objSubjectNode
Set objTreeManager = QCConnection.TreeManager
Set objSubjectNode = objTreeManager.NodeByPath(RootNode)
'Run on all children nodes
Dim i, intNewUpper
For i = 1 To objSubjectNode.Count
'If current node has a child then get path on child nodes too.
If objSubjectNode.Child(i).Count >= 1 Then
Dim arrStrTempNodeList
arrStrTempNodeList = GetNodesList(objSubjectNode.Child(i).Path)
Dim strNode
For Each strNode In arrStrTempNodeList
'Add more space to dynamic array
intNewUpper = UBound(arrStrNodesList) + 1
ReDim Preserve arrStrNodesList(intNewUpper)
'Add strNode path to array
arrStrNodesList(intNewUpper) = strNode
Next
Else
'Add more space to dynamic array
intNewUpper = UBound(arrStrNodesList) + 1
ReDim Preserve arrStrNodesList(intNewUpper)
'Add strNode path to array
arrStrNodesList(intNewUpper) = objSubjectNode.Child(i).Path
End If
Next
' Cleanup objects
Set objSubjectNode = Nothing
Set objTreeManager = Nothing
GetNodesList = arrStrNodesList
End Function
'*
'Creates a file system folder including parent folders
'
'@param: strFolderPath The fully qualified directory of folders to create.
'
'@return: boolean True is returned if the folders were sucessfully created; False if not.
'*
Function CreateFolderPath(ByVal strFolderPath)
Dim blnRetVal
blnRetVal = False
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Input checking
If strFolderPath <> "" Then
'If the folder doesn't exist then recursively create parent folder
If objFSO.FolderExists(strFolderPath) = False Then
If CreateFolderPath(objFSO.GetParentFolderName(strFolderPath)) = True Then
On Error Resume Next
objFSO.CreateFolder(strFolderPath)
If Err.Number <> 0 Then
Wscript.Echo "Error in creating folder: " & Err.Number
Wscript.Echo "Error (Hex): " & Hex(Err.Number)
Wscript.Echo "Source: " & Err.Source
Wscript.Echo "Description: " & Err.Description
Wscript.Echo "Folder to create: " & strFolderToCreate
blnRetVal = False
Else
blnRetVal = True
End If
Err.Clear
On Error Goto 0
End If
Else
'Folder exists.
blnRetVal = True
End If
Else
'Either root folder or no path sent.
blnRetVal = False
End If
Set objFSO = Nothing
CreateFolderPath = blnRetVal
End Function
'*
'Provides a nice container for QTP tests Names and Paths.
'*
Class TestClass
Private strName
Private strPath
'Set and Get for Name
Property Get Name
Name = strName
End Property
Property Let Name(sName)
strName = sName
End Property
'Set and Get for Path
Property Get Path
Path = strPath
End Property
Property Let Path(sPath)
strPath = sPath
End Property
End Class
Step3: I don't have any idea on this right now... But, I have built one few years back for my own using simple excel and db.
Let me know if you are still looking for any more information.
Thanks,
SUpputuri
SUpputuri