Rati Saxena

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2008-08-15
11:34
9250 views
Export Test scripts from QC to Excel in Bulk
The script given to export the testcases and test scenario from QC to Excel doesn't work. Can anyone provide the updated script and let me know how to Export the data from QC to Excel????
262 Replies
.anup.

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-15
15:32
Hi, I am using this code to extract all test cases under a specific test plan folder from QC to Excel. But this only downloads the test scripts in the folder and those in the subfolders are not extracted. What can be the problem here?
-------
Dim TreeMgr, TestTree, TestFactory, TestList
Set TreeMgr = QCConnection.TreeManager
strNodeByPath = "Subject\Folder1"
Set TestTree = TreeMgr.NodeByPath(strNodeByPath )
Set TestFactory = TestTree.TestFactory
Set TestList = TestFactory.NewList("")
For Each TestCase In TestList
...
-------
Dim TreeMgr, TestTree, TestFactory, TestList
Set TreeMgr = QCConnection.TreeManager
strNodeByPath = "Subject\Folder1"
Set TestTree = TreeMgr.NodeByPath(strNodeByPath )
Set TestFactory = TestTree.TestFactory
Set TestList = TestFactory.NewList("")
For Each TestCase In TestList
...
Percy Bell

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-15
15:50
anup,
You need to recursively get all subfolders for a node. In my script I provided a function to do just that. After running this subroutine NodesList will be an array of all nodes for a give TestTree node.
'Gets subnodes and return list in array NodesList
Call GetNodesList(TestTree, NodesList)
''
'Returns a NodesList array for all children of a given node of a tree.
'
'@param: Node Node in a Test Lab tree.
'
'@param: NodesList Array to store all children of a given node of a tree.
'
'@return: No explicit return value.
Function GetNodesList(ByVal Node, ByRef NodesList)
Dim i
'Run on all children nodes
For i = 1 To Node.Count
Dim NewUpper
'Add more space to dynamic array
NewUpper = UBound(NodesList) + 1
ReDim Preserve NodesList(NewUpper)
'Add node path to array
NodesList(NewUpper) = Node.Child(i).Path
'If current node has a child then get path on child nodes too.
If Node.Child(i).Count >= 1 Then
Call GetNodesList(Node.Child(i), NodesList)
End If
Next
End Function
You need to recursively get all subfolders for a node. In my script I provided a function to do just that. After running this subroutine NodesList will be an array of all nodes for a give TestTree node.
'Gets subnodes and return list in array NodesList
Call GetNodesList(TestTree, NodesList)
''
'Returns a NodesList array for all children of a given node of a tree.
'
'@param: Node Node in a Test Lab tree.
'
'@param: NodesList Array to store all children of a given node of a tree.
'
'@return: No explicit return value.
Function GetNodesList(ByVal Node, ByRef NodesList)
Dim i
'Run on all children nodes
For i = 1 To Node.Count
Dim NewUpper
'Add more space to dynamic array
NewUpper = UBound(NodesList) + 1
ReDim Preserve NodesList(NewUpper)
'Add node path to array
NodesList(NewUpper) = Node.Child(i).Path
'If current node has a child then get path on child nodes too.
If Node.Child(i).Count >= 1 Then
Call GetNodesList(Node.Child(i), NodesList)
End If
Next
End Function
Shivaraj

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-15
15:58
Hi all,
You can also try using Excel reports to get the test cases. Check out this thread - http://forums11.itrc.hp.com/service/forums/questionanswer.do?threadId=1392190
Thanks,
Shivaraj
You can also try using Excel reports to get the test cases. Check out this thread - http://forums11.itrc.hp.com/service/forums/questionanswer.do?threadId=1392190
Thanks,
Shivaraj
.anup.

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-16
10:07
Percy, thanks for the prompt reply.
This is how I am calling the function you provided,
---------------
Set TreeMgr = QCConnection.TreeManager
strNodeByPath = "Subject\Folder1"
Set TestTree = TreeMgr.NodeByPath(strNodeByPath)
Call GetNodesList(TestTree, NodesList)
For n = 1 To UBound(NodesList)
Set TestTree = TreeMgr.NodeByPath(NodesList(n))
Set TestFactory = TestTree.TestFactory
'Set TestFactory = QCConnection.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all tests.
For Each TestCase In TestListâ ¦
----------------
Two problems here:
1. Getting Type Mismatch error in this line of your function:
NewUpper = UBound(NodesList) + 1
2. Also, I have no idea which arguments to pass to the function. I am just guessing here.
Shivaraj,
Thanks for the input, but I do not have the access rights for Exporting Excel Reports.
This is how I am calling the function you provided,
---------------
Set TreeMgr = QCConnection.TreeManager
strNodeByPath = "Subject\Folder1"
Set TestTree = TreeMgr.NodeByPath(strNodeByPath)
Call GetNodesList(TestTree, NodesList)
For n = 1 To UBound(NodesList)
Set TestTree = TreeMgr.NodeByPath(NodesList(n))
Set TestFactory = TestTree.TestFactory
'Set TestFactory = QCConnection.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all tests.
For Each TestCase In TestListâ ¦
----------------
Two problems here:
1. Getting Type Mismatch error in this line of your function:
NewUpper = UBound(NodesList) + 1
2. Also, I have no idea which arguments to pass to the function. I am just guessing here.
Shivaraj,
Thanks for the input, but I do not have the access rights for Exporting Excel Reports.
Percy Bell

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-16
14:53
My function is expecting an existing array that it can extend to add the new elements. The first element is created outside of the function. Use the following code below and it should work:
Set TreeMgr = QCConnection.TreeManager
strNodeByPath = "Subject\Folder1"
Set TestTree = TreeMgr.NodeByPath(strNodeByPath)
'Specify Array to contain all nodes of subject tree.
Dim NodesList()
ReDim Preserve NodesList(0)
'Assign root node of subject tree as NodeByPath node.
NodesList(0) = TestTree.Path
Call GetNodesList(TestTree, NodesList)
For n = 1 To UBound(NodesList)
Set TestTree = TreeMgr.NodeByPath(NodesList(n))
Set TestFactory = TestTree.TestFactory
'Set TestFactory = QCConnection.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all tests.
For Each TestCase In TestListâ ¦
Set TreeMgr = QCConnection.TreeManager
strNodeByPath = "Subject\Folder1"
Set TestTree = TreeMgr.NodeByPath(strNodeByPath)
'Specify Array to contain all nodes of subject tree.
Dim NodesList()
ReDim Preserve NodesList(0)
'Assign root node of subject tree as NodeByPath node.
NodesList(0) = TestTree.Path
Call GetNodesList(TestTree, NodesList)
For n = 1 To UBound(NodesList)
Set TestTree = TreeMgr.NodeByPath(NodesList(n))
Set TestFactory = TestTree.TestFactory
'Set TestFactory = QCConnection.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all tests.
For Each TestCase In TestListâ ¦
.anup.

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-17
12:37
Percy,
Its working as I wanted. Many thanks for the help. You saved the day!
Its working as I wanted. Many thanks for the help. You saved the day!
Percy Bell

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-17
14:13
abup,
Just noticed that you started your for loop at 1. I put in the root node at index 0 so you want your loop to start at 0 to make sure you get all the tests.
Glad it worked out for you.
Just noticed that you started your for loop at 1. I put in the root node at index 0 so you want your loop to start at 0 to make sure you get all the tests.
Glad it worked out for you.
ravim_1

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-22
19:03
Hi Percy,
i tried running this query in the excel and am getting the following error when running
Invalid Outside preocedure and pointing to 'Set'
I am pretty new to running this queries
here are the steps i followed
Exported the script and clicked on Debug and that gave the above error
Option Explicit
'==========================================================================
'
' Quality Center Defect and Test Case Exporter
'
' NAME: QCDefects.vbs
'
' AUTHOR: Percy Bell
' DATE : 8/25/2008
'
'
' COMMENT:
' Original source:
' http://blogs.exposit.co.uk/2007/04/23/ota-an-api-for-extending-quality-center/
'
'==========================================================================
Const xlLeft = -4131
Const xlRight = -4152
Const xlCenter = -4108
Const xlGeneral = 1
Dim QCConnection
'Return the TDConnection object.
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
Dim sUserName, sPassword
sUserName = "<>" '<-- Change me.
sPassword = "<>" '<-- Change me.
QCConnection.InitConnectionEx "http:" '<-- Change me.
QCConnection.Login sUserName, sPassword
If (QCConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
WScript.Quit
End If
Dim sDomain, sProject
sDomain = "" '<-- Change me.
sProject = "" '<-- Change me.
QCConnection.Connect sDomain, sProject
If (QCConnection.Connected <> True) Then
MsgBox "QC Project Failed to Connect to " & sProject
WScript.Quit
End If
Call ExportTestCases("Subject\") '<-- Change me.
Call ExportDefects()
QCConnection.Disconnect
QCConnection.Logout
QCConnection.ReleaseConnection
'------------------------------------------------------
''
'Print all the Fields for the passed in object.
'
'@param: objObject Object that supports the Fields method.
'
'@return: No return value.
Function PrintFields(objObject)
Dim FieldsList, Field
Set FieldsList = objObject.Fields
For Each Field In FieldsList
WScript.Echo Field
Next
End Function
''
'Export test cases for the Test Lab node.
'
'@param: strNodeByPath String for the node path in Test Lab.
'
'@return: No return value.
Function ExportTestCases(strNodeByPath)
Dim Excel, Sheet
Set Excel = CreateObject("Excel.Application") 'Open Excel
Excel.WorkBooks.Add() 'Add a new workbook
'Get the first worksheet.
Set Sheet = Excel.ActiveSheet
Sheet.Name = "Tests"
With Sheet.Range("A1:H1")
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 15 'Light Grey
End With
Sheet.Cells(1, 1) = "Subject (Folder Name)"
Sheet.Cells(1, 2) = "Test Name (Manual Test Plan Name)"
Sheet.Cells(1, 3) = "Description"
Sheet.Cells(1, 4) = "Designer (Owner)"
Sheet.Cells(1, 5) = "Status"
Sheet.Cells(1, 6) = "Step Name"
Sheet.Cells(1, 7) = "Step Description(Action)"
Sheet.Cells(1, 😎 = "Expected Result"
'Call PrintFields(TestFactory)
Dim TreeMgr, TestTree, TestFactory, TestList
Set TreeMgr = QCConnection.TreeManager
'Specify the folder path in TestPlan, all the tests under that folder will be exported.
Set TestTree = TreeMgr.NodeByPath(strNodeByPath)
Set TestFactory = TestTree.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all from node.
'Specify Array to contain all nodes of subject tree.
Dim NodesList()
ReDim Preserve NodesList(0)
'Assign root node of subject tree as NodeByPath node.
NodesList(0) = TestTree.Path
'Gets subnodes and return list in array NodesList
Call GetNodesList(TestTree, NodesList)
Dim Row, Node, TestCase
Row = 2
For Each Node In NodesList
Set TestTree = TreeMgr.NodeByPath(Node)
Set TestFactory = TestTree.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all from node.
'Iterate through all the tests.
For Each TestCase In TestList
Dim DesignStepFactory, DesignStep, DesignStepList
Set DesignStepFactory = TestCase.DesignStepFactory
Set DesignStepList = DesignStepFactory.NewList("")
If DesignStepList.Count = 0 Then
'Save a specified set of fields.
Sheet.Cells(Row, 1).Value = TestCase.Field("TS_SUBJECT").Path
Sheet.Cells(Row, 2).Value = TestCase.Field("TS_NAME")
Sheet.Cells(Row, 3).Value = TestCase.Field("TS_DESCRIPTION")
Sheet.Cells(Row, 4).Value = TestCase.Field("TS_RESPONSIBLE")
Sheet.Cells(Row, 5).Value = TestCase.Field("TS_STATUS")
Row = Row + 1
Else
For Each DesignStep In DesignStepList
'Save a specified set of fields.
Sheet.Cells(Row, 1).Value = TestCase.Field("TS_SUBJECT").Path
Sheet.Cells(Row, 2).Value = TestCase.Field("TS_NAME")
Sheet.Cells(Row, 3).Value = TestCase.Field("TS_DESCRIPTION")
Sheet.Cells(Row, 4).Value = TestCase.Field("TS_RESPONSIBLE")
Sheet.Cells(Row, 5).Value = TestCase.Field("TS_STATUS")
'Save the specified design steps.
Sheet.Cells(Row, 6).Value = DesignStep.StepName
Sheet.Cells(Row, 7).Value = DesignStep.StepDescription
Sheet.Cells(Row, 8).Value = DesignStep.StepExpectedResult
Row = Row + 1
Next
End If
Next
Next
'Call PrintFields(DesignStepFactory)
Excel.Columns.AutoFit
'Set the Column width for the following columns.
Excel.Columns("C").ColumnWidth = 80 'Description
Excel.Columns("G").ColumnWidth = 80 'Step Description(Action)
Excel.Columns("H").ColumnWidth = 80 'Expected Result
'Set Auto Filter mode.
If Not Sheet.AutoFilterMode Then
Sheet.Range("A1").AutoFilter
End If
'Freeze first row.
Sheet.Range("A2").Select
Excel.ActiveWindow.FreezePanes = True
'Save the newly created workbook and close Excel.
Excel.ActiveWorkbook.SaveAs("C:\" & sProject & "_TESTCASES.xls")
Excel.Quit
Set Excel = Nothing
Set DesignStepList = Nothing
Set DesignStepFactory = Nothing
Set TestList = Nothing
Set TestFactory = Nothing
Set TestTree = Nothing
Set TreeMgr = Nothing
End Function
''
'Export all defects for the current project.
'
'@return: No return value.
Function ExportDefects()
Dim BugFactory, BugList
Set BugFactory = QCConnection.BugFactory
Set BugList = BugFactory.NewList("") 'Get a list of all the defects.
Dim Excel, Sheet
Set Excel = CreateObject("Excel.Application") 'Open Excel
Excel.WorkBooks.Add() 'Add a new workbook
'Get the first worksheet.
Set Sheet = Excel.ActiveSheet
Sheet.Name = "Defects"
With Sheet.Range("A1:U1")
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 15 'Light Grey
End With
Sheet.Cells(1, 1) = "DefectID"
Sheet.Cells(1, 2) = "Status"
Sheet.Cells(1, 3) = "Severity"
Sheet.Cells(1, 4) = "Priority"
Sheet.Cells(1, 5) = "Summary"
Sheet.Cells(1, 6) = "Detected By"
Sheet.Cells(1, 7) = "Found in Version"
Sheet.Cells(1, 😎 = "Found in Build"
Sheet.Cells(1, 9) = "Detected on Date"
Sheet.Cells(1, 10) = "Closing Date"
Sheet.Cells(1, 11) = "Actual Fix Time(Days)"
Sheet.Cells(1, 12) = "Type"
Sheet.Cells(1, 13) = "Module"
Sheet.Cells(1, 14) = "Fixed in Version"
Sheet.Cells(1, 15) = "Fixed in Build"
Sheet.Cells(1, 16) = "Tester Closing Date"
Sheet.Cells(1, 17) = "Email"
Sheet.Cells(1, 18) = "Submission Date"
Sheet.Cells(1, 19) = "Business Impact"
Sheet.Cells(1, 20) = "Subject"
Sheet.Cells(1, 21) = "Assigned To"
'Call PrintFields(BugFactory)
Dim Row, Bug
Row = 2
'Iterate through all the defects.
For Each Bug In BugList
'Save a specified set of fields.
Sheet.Cells(Row, 1).Value = Bug.Field("BG_BUG_ID")
Sheet.Cells(Row, 2).Value = Bug.Status
Sheet.Cells(Row, 3).Value = Bug.Field("BG_SEVERITY")
Sheet.Cells(Row, 4).Value = Bug.Priority
Sheet.Cells(Row, 5).Value = Bug.Summary
Sheet.Cells(Row, 6).Value = Bug.DetectedBy
Sheet.Cells(Row, 7).Value = Bug.Field("BG_DETECTION_VERSION")
Sheet.Cells(Row, 8).Value = Bug.Field("BG_USER_03")
Sheet.Cells(Row, 9).Value = Bug.Field("BG_DETECTION_DATE")
Sheet.Cells(Row, 10).Value = Bug.Field("BG_CLOSING_DATE")
Sheet.Cells(Row, 11).Value = Bug.Field("BG_ACTUAL_FIX_TIME")
Sheet.Cells(Row, 12).Value = Bug.Field("BG_USER_01")
Sheet.Cells(Row, 13).Value = Bug.Field("BG_USER_02")
Sheet.Cells(Row, 14).Value = Bug.Field("BG_USER_06")
Sheet.Cells(Row, 15).Value = Bug.Field("BG_USER_04")
Sheet.Cells(Row, 16).Value = Bug.Field("BG_USER_05")
Sheet.Cells(Row, 17).Value = Bug.Field("BG_USER_07")
Sheet.Cells(Row, 18).Value = Bug.Field("BG_USER_08")
Sheet.Cells(Row, 19).Value = Bug.Field("BG_USER_09")
Sheet.Cells(Row, 20).Value = Bug.Field("BG_SUBJECT")
Sheet.Cells(Row, 21).Value = Bug.AssignedTo
Row = Row + 1
Next
Excel.Columns.AutoFit
'Set the Column width for the following columns.
Excel.Columns("C").ColumnWidth = 80 'Summary
'Set Auto Filter mode.
If Not Sheet.AutoFilterMode Then
Sheet.Range("A1").AutoFilter
End If
'Freeze first row.
Sheet.Range("A2").Select
Excel.ActiveWindow.FreezePanes = True
'Save the newly created workbook and close Excel.
Excel.ActiveWorkbook.SaveAs("C:\" & sProject & "_DEFECTS.xls")
Excel.Quit
Set Excel = Nothing
Set BugList = Nothing
Set BugFactory = Nothing
End Function
''
'Returns a NodesList array for all children of a given node of a tree.
'
'@param: Node Node in a Test Lab tree.
'
'@param: NodesList Array to store all children of a given node of a tree.
'
'@return: No explicit return value.
Function GetNodesList(ByVal Node, ByRef NodesList)
Dim i
'Run on all children nodes
For i = 1 To Node.Count
Dim NewUpper
'Add more space to dynamic array
NewUpper = UBound(NodesList) + 1
ReDim Preserve NodesList(NewUpper)
'Add node path to array
NodesList(NewUpper) = Node.Child(i).Path
'If current node has a child then get path on child nodes too.
If Node.Child(i).Count >= 1 Then
Call GetNodesList(Node.Child(i), NodesList)
End If
Next
End Function
''
'Strips all the HTML tags from a string.
'
'@param: strHTML A string with HTML tagges embedded.
'
'@return: A string with all HTML tags stripped.
Function stripHTML(strHTML)
'Strips the HTML tags from strHTML
Dim objRegExp, strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<(.|\n)+?>"
'Replace all line breaks with VB line breaks
strOutput = Replace(strHTML, "
", vbLf)
'Replace all HTML tag matches with the empty string
strOutput = objRegExp.Replace(strOutput, "")
'Replace all <, >, and " with <, >, and "
strOutput = Replace(strOutput, "<", "<")
strOutput = Replace(strOutput, ">", ">")
strOutput = Replace(strOutput, """, Chr(34))
Set objRegExp = Nothing
stripHTML = strOutput 'Return the value of strOutput
End Function
''
'Truncates a string to 32,767 characters for excel.
'
'@param: strText String to be truncated.
'
'@return: Truncated string.
Function Truncate(strText)
'Excel Max Cell Length = 32,767
Dim sNotice
sNotice = vbLf & "Contents Truncated..."
If Len(strText) > 32767 Then
strText = Left(strText, 32767 - Len(sNotice))
strText = strText & sNotice
End If
Truncate = strText
End Function
i tried running this query in the excel and am getting the following error when running
Invalid Outside preocedure and pointing to 'Set'
I am pretty new to running this queries
here are the steps i followed
Exported the script and clicked on Debug and that gave the above error
Option Explicit
'==========================================================================
'
' Quality Center Defect and Test Case Exporter
'
' NAME: QCDefects.vbs
'
' AUTHOR: Percy Bell
' DATE : 8/25/2008
'
'
' COMMENT:
' Original source:
' http://blogs.exposit.co.uk/2007/04/23/ota-an-api-for-extending-quality-center/
'
'==========================================================================
Const xlLeft = -4131
Const xlRight = -4152
Const xlCenter = -4108
Const xlGeneral = 1
Dim QCConnection
'Return the TDConnection object.
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
Dim sUserName, sPassword
sUserName = "<>" '<-- Change me.
sPassword = "<>" '<-- Change me.
QCConnection.InitConnectionEx "http:" '<-- Change me.
QCConnection.Login sUserName, sPassword
If (QCConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
WScript.Quit
End If
Dim sDomain, sProject
sDomain = "
sProject = "
QCConnection.Connect sDomain, sProject
If (QCConnection.Connected <> True) Then
MsgBox "QC Project Failed to Connect to " & sProject
WScript.Quit
End If
Call ExportTestCases("Subject\") '<-- Change me.
Call ExportDefects()
QCConnection.Disconnect
QCConnection.Logout
QCConnection.ReleaseConnection
'------------------------------------------------------
''
'Print all the Fields for the passed in object.
'
'@param: objObject Object that supports the Fields method.
'
'@return: No return value.
Function PrintFields(objObject)
Dim FieldsList, Field
Set FieldsList = objObject.Fields
For Each Field In FieldsList
WScript.Echo Field
Next
End Function
''
'Export test cases for the Test Lab node.
'
'@param: strNodeByPath String for the node path in Test Lab.
'
'@return: No return value.
Function ExportTestCases(strNodeByPath)
Dim Excel, Sheet
Set Excel = CreateObject("Excel.Application") 'Open Excel
Excel.WorkBooks.Add() 'Add a new workbook
'Get the first worksheet.
Set Sheet = Excel.ActiveSheet
Sheet.Name = "Tests"
With Sheet.Range("A1:H1")
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 15 'Light Grey
End With
Sheet.Cells(1, 1) = "Subject (Folder Name)"
Sheet.Cells(1, 2) = "Test Name (Manual Test Plan Name)"
Sheet.Cells(1, 3) = "Description"
Sheet.Cells(1, 4) = "Designer (Owner)"
Sheet.Cells(1, 5) = "Status"
Sheet.Cells(1, 6) = "Step Name"
Sheet.Cells(1, 7) = "Step Description(Action)"
Sheet.Cells(1, 😎 = "Expected Result"
'Call PrintFields(TestFactory)
Dim TreeMgr, TestTree, TestFactory, TestList
Set TreeMgr = QCConnection.TreeManager
'Specify the folder path in TestPlan, all the tests under that folder will be exported.
Set TestTree = TreeMgr.NodeByPath(strNodeByPath)
Set TestFactory = TestTree.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all from node.
'Specify Array to contain all nodes of subject tree.
Dim NodesList()
ReDim Preserve NodesList(0)
'Assign root node of subject tree as NodeByPath node.
NodesList(0) = TestTree.Path
'Gets subnodes and return list in array NodesList
Call GetNodesList(TestTree, NodesList)
Dim Row, Node, TestCase
Row = 2
For Each Node In NodesList
Set TestTree = TreeMgr.NodeByPath(Node)
Set TestFactory = TestTree.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all from node.
'Iterate through all the tests.
For Each TestCase In TestList
Dim DesignStepFactory, DesignStep, DesignStepList
Set DesignStepFactory = TestCase.DesignStepFactory
Set DesignStepList = DesignStepFactory.NewList("")
If DesignStepList.Count = 0 Then
'Save a specified set of fields.
Sheet.Cells(Row, 1).Value = TestCase.Field("TS_SUBJECT").Path
Sheet.Cells(Row, 2).Value = TestCase.Field("TS_NAME")
Sheet.Cells(Row, 3).Value = TestCase.Field("TS_DESCRIPTION")
Sheet.Cells(Row, 4).Value = TestCase.Field("TS_RESPONSIBLE")
Sheet.Cells(Row, 5).Value = TestCase.Field("TS_STATUS")
Row = Row + 1
Else
For Each DesignStep In DesignStepList
'Save a specified set of fields.
Sheet.Cells(Row, 1).Value = TestCase.Field("TS_SUBJECT").Path
Sheet.Cells(Row, 2).Value = TestCase.Field("TS_NAME")
Sheet.Cells(Row, 3).Value = TestCase.Field("TS_DESCRIPTION")
Sheet.Cells(Row, 4).Value = TestCase.Field("TS_RESPONSIBLE")
Sheet.Cells(Row, 5).Value = TestCase.Field("TS_STATUS")
'Save the specified design steps.
Sheet.Cells(Row, 6).Value = DesignStep.StepName
Sheet.Cells(Row, 7).Value = DesignStep.StepDescription
Sheet.Cells(Row, 8).Value = DesignStep.StepExpectedResult
Row = Row + 1
Next
End If
Next
Next
'Call PrintFields(DesignStepFactory)
Excel.Columns.AutoFit
'Set the Column width for the following columns.
Excel.Columns("C").ColumnWidth = 80 'Description
Excel.Columns("G").ColumnWidth = 80 'Step Description(Action)
Excel.Columns("H").ColumnWidth = 80 'Expected Result
'Set Auto Filter mode.
If Not Sheet.AutoFilterMode Then
Sheet.Range("A1").AutoFilter
End If
'Freeze first row.
Sheet.Range("A2").Select
Excel.ActiveWindow.FreezePanes = True
'Save the newly created workbook and close Excel.
Excel.ActiveWorkbook.SaveAs("C:\" & sProject & "_TESTCASES.xls")
Excel.Quit
Set Excel = Nothing
Set DesignStepList = Nothing
Set DesignStepFactory = Nothing
Set TestList = Nothing
Set TestFactory = Nothing
Set TestTree = Nothing
Set TreeMgr = Nothing
End Function
''
'Export all defects for the current project.
'
'@return: No return value.
Function ExportDefects()
Dim BugFactory, BugList
Set BugFactory = QCConnection.BugFactory
Set BugList = BugFactory.NewList("") 'Get a list of all the defects.
Dim Excel, Sheet
Set Excel = CreateObject("Excel.Application") 'Open Excel
Excel.WorkBooks.Add() 'Add a new workbook
'Get the first worksheet.
Set Sheet = Excel.ActiveSheet
Sheet.Name = "Defects"
With Sheet.Range("A1:U1")
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 15 'Light Grey
End With
Sheet.Cells(1, 1) = "DefectID"
Sheet.Cells(1, 2) = "Status"
Sheet.Cells(1, 3) = "Severity"
Sheet.Cells(1, 4) = "Priority"
Sheet.Cells(1, 5) = "Summary"
Sheet.Cells(1, 6) = "Detected By"
Sheet.Cells(1, 7) = "Found in Version"
Sheet.Cells(1, 😎 = "Found in Build"
Sheet.Cells(1, 9) = "Detected on Date"
Sheet.Cells(1, 10) = "Closing Date"
Sheet.Cells(1, 11) = "Actual Fix Time(Days)"
Sheet.Cells(1, 12) = "Type"
Sheet.Cells(1, 13) = "Module"
Sheet.Cells(1, 14) = "Fixed in Version"
Sheet.Cells(1, 15) = "Fixed in Build"
Sheet.Cells(1, 16) = "Tester Closing Date"
Sheet.Cells(1, 17) = "Email"
Sheet.Cells(1, 18) = "Submission Date"
Sheet.Cells(1, 19) = "Business Impact"
Sheet.Cells(1, 20) = "Subject"
Sheet.Cells(1, 21) = "Assigned To"
'Call PrintFields(BugFactory)
Dim Row, Bug
Row = 2
'Iterate through all the defects.
For Each Bug In BugList
'Save a specified set of fields.
Sheet.Cells(Row, 1).Value = Bug.Field("BG_BUG_ID")
Sheet.Cells(Row, 2).Value = Bug.Status
Sheet.Cells(Row, 3).Value = Bug.Field("BG_SEVERITY")
Sheet.Cells(Row, 4).Value = Bug.Priority
Sheet.Cells(Row, 5).Value = Bug.Summary
Sheet.Cells(Row, 6).Value = Bug.DetectedBy
Sheet.Cells(Row, 7).Value = Bug.Field("BG_DETECTION_VERSION")
Sheet.Cells(Row, 8).Value = Bug.Field("BG_USER_03")
Sheet.Cells(Row, 9).Value = Bug.Field("BG_DETECTION_DATE")
Sheet.Cells(Row, 10).Value = Bug.Field("BG_CLOSING_DATE")
Sheet.Cells(Row, 11).Value = Bug.Field("BG_ACTUAL_FIX_TIME")
Sheet.Cells(Row, 12).Value = Bug.Field("BG_USER_01")
Sheet.Cells(Row, 13).Value = Bug.Field("BG_USER_02")
Sheet.Cells(Row, 14).Value = Bug.Field("BG_USER_06")
Sheet.Cells(Row, 15).Value = Bug.Field("BG_USER_04")
Sheet.Cells(Row, 16).Value = Bug.Field("BG_USER_05")
Sheet.Cells(Row, 17).Value = Bug.Field("BG_USER_07")
Sheet.Cells(Row, 18).Value = Bug.Field("BG_USER_08")
Sheet.Cells(Row, 19).Value = Bug.Field("BG_USER_09")
Sheet.Cells(Row, 20).Value = Bug.Field("BG_SUBJECT")
Sheet.Cells(Row, 21).Value = Bug.AssignedTo
Row = Row + 1
Next
Excel.Columns.AutoFit
'Set the Column width for the following columns.
Excel.Columns("C").ColumnWidth = 80 'Summary
'Set Auto Filter mode.
If Not Sheet.AutoFilterMode Then
Sheet.Range("A1").AutoFilter
End If
'Freeze first row.
Sheet.Range("A2").Select
Excel.ActiveWindow.FreezePanes = True
'Save the newly created workbook and close Excel.
Excel.ActiveWorkbook.SaveAs("C:\" & sProject & "_DEFECTS.xls")
Excel.Quit
Set Excel = Nothing
Set BugList = Nothing
Set BugFactory = Nothing
End Function
''
'Returns a NodesList array for all children of a given node of a tree.
'
'@param: Node Node in a Test Lab tree.
'
'@param: NodesList Array to store all children of a given node of a tree.
'
'@return: No explicit return value.
Function GetNodesList(ByVal Node, ByRef NodesList)
Dim i
'Run on all children nodes
For i = 1 To Node.Count
Dim NewUpper
'Add more space to dynamic array
NewUpper = UBound(NodesList) + 1
ReDim Preserve NodesList(NewUpper)
'Add node path to array
NodesList(NewUpper) = Node.Child(i).Path
'If current node has a child then get path on child nodes too.
If Node.Child(i).Count >= 1 Then
Call GetNodesList(Node.Child(i), NodesList)
End If
Next
End Function
''
'Strips all the HTML tags from a string.
'
'@param: strHTML A string with HTML tagges embedded.
'
'@return: A string with all HTML tags stripped.
Function stripHTML(strHTML)
'Strips the HTML tags from strHTML
Dim objRegExp, strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<(.|\n)+?>"
'Replace all line breaks with VB line breaks
strOutput = Replace(strHTML, "
", vbLf)
'Replace all HTML tag matches with the empty string
strOutput = objRegExp.Replace(strOutput, "")
'Replace all <, >, and " with <, >, and "
strOutput = Replace(strOutput, "<", "<")
strOutput = Replace(strOutput, ">", ">")
strOutput = Replace(strOutput, """, Chr(34))
Set objRegExp = Nothing
stripHTML = strOutput 'Return the value of strOutput
End Function
''
'Truncates a string to 32,767 characters for excel.
'
'@param: strText String to be truncated.
'
'@return: Truncated string.
Function Truncate(strText)
'Excel Max Cell Length = 32,767
Dim sNotice
sNotice = vbLf & "Contents Truncated..."
If Len(strText) > 32767 Then
strText = Left(strText, 32767 - Len(sNotice))
strText = strText & sNotice
End If
Truncate = strText
End Function
ravim_1

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-29
18:34
Hi,
I am looking if there is anyone who can help me out in running this query as i am getting some errors and i am nto sure if i am going though the right procedure for running this query.
Wehere do i have to run this query to get the test cases exported to the excel.
We badly need this today and anyone helping on this would be really really appreciated
I am looking if there is anyone who can help me out in running this query as i am getting some errors and i am nto sure if i am going though the right procedure for running this query.
Wehere do i have to run this query to get the test cases exported to the excel.
We badly need this today and anyone helping on this would be really really appreciated
moni_3

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-29
20:49
Hi Percy
I am getting an error "compile error" invalid outside procedure.when I am running this script.what might be the reason?
Please help
I am getting an error "compile error" invalid outside procedure.when I am running this script.what might be the reason?
Please help
ravim_1

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2009-12-30
18:25
Hi Moni,
Looks like you are doing the same mistake as i did.
-Copy paste all the code mentioned above in a text pad or notepad and save as .vbs file
-After updating all the 'change me' fields in the code save it and double click on the file
I think this should work.
I got the same compile error out of procedure error when i am trying ...luckily i was able to go through it yesterday after several attempts
Hope this helps...
Looks like you are doing the same mistake as i did.
-Copy paste all the code mentioned above in a text pad or notepad and save as .vbs file
-After updating all the 'change me' fields in the code save it and double click on the file
I think this should work.
I got the same compile error out of procedure error when i am trying ...luckily i was able to go through it yesterday after several attempts
Hope this helps...
Robert Chaney

Absent Member.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Email to a Friend
- Report Inappropriate Content
2010-01-18
17:12
Mahavir
When I add the snippet you created to include the 'call' step (in the For Each Design Step loop), I receive a "variable undefined: 'objSheet'" error .. what am I missing? need to change? need to add?
Thanks
Bob
When I add the snippet you created to include the 'call' step (in the For Each Design Step loop), I receive a "variable undefined: 'objSheet'" error .. what am I missing? need to change? need to add?
Thanks
Bob