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 = "
sPassword = "
QCConnection.InitConnectionEx "http:
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("
'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) = "Test Type"
Sheet.Cells(1, 6) = "Step Name"
Sheet.Cells(1, 7) = "Step Description(Action)"
Sheet.Cells(1, 8) = "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")
Sheet.Cells(Row, 5).Value = TestCase.Field("TS_ID")
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 = stripHTML(TestCase.Field("TS_DESCRIPTION"))
Sheet.Cells(Row, 4).Value = TestCase.Field("TS_RESPONSIBLE")
Sheet.Cells(Row, 5).Value = TestCase.Field("TS_ID")
'Save the specified design steps.
Sheet.Cells(Row, 6).Value = stripHTML(DesignStep.StepName)
Sheet.Cells(Row, 7).Value = stripHTML(DesignStep.StepDescription)
Sheet.Cells(Row, 8).Value = stripHTML(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, 8) = "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
No comments:
Post a Comment