Quality Center Defect and Test Case Exporter

'---- AUTHOR: Percy Bell

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("") '<-- 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) = "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

Function to generate Random String\Value

Randomize

Public Function GenerateRandomVal(intValType,intNumChar)
Dim strText,strStart,strRndVal
Randomize
if intValType = 1 then
strText = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
msgbox(strText)
Elseif intValType=2 Then
strText = "123456789"
msgbox(strText)
End If
For intCount=1 to intNumChar
strStart=int(Rnd * (Len(strText)))+1

strRndVal= strRndVal & Mid(strText, strStart,1)
Next
GenerateRandomVal=strRndVal
msgbox(GenerateRandomVal)
End Function

Opening QC through QTP

Set Qtapp = Createobject("Quicktest.Application")
Dim TDConnection
Qtapp.TDConnection.connect "Server name","domain name","project", "username","pswd",FALSE

Searching a value in excel and mark row with color

Set appExcel = CreateObject("Excel.Application")
appExcel.visible=true
Set objWorkBook = appExcel.Workbooks.Open ("C:\IT_TEam.xls")
Set objsheet = objWorkBook.sheets("Sheet1")
''With objsheet.UsedRange
''Set a = .Find("")
For Each a in objsheet.UsedRange
If a = "" Then
a.Interior.ColorIndex = 50
End If
'Set a= .FindNext(a)
Next
'End with
objworkbook.Save
objworkbook.Close
Set appExcel = nothing

Running QTP when system is lock

Change the following registry settings..

HKEY_LOCAL_MACHINE\SOFTWARE\Mercury Interactive\QuickTest Professional\MicTest

Locate the key “SkipEnvironmentChecks”

By Default the value will be “0″

Change the value to “1″ and restart the QTP.

Now QTP can run even if the system is lock.