Question

我想从Excel工作表中更新我在Qc的测试实验室中的测试用例状态。我经历了很多帖子，但找不到一个好的解决方案。我终于明白了，现在我发布了答案供你调查，以便对其他人也有所帮助。

请在下面找到答案：
我已经硬编码了你可以把它作为参数传递给你。

感谢

Answer 1

Sub ConnectToQualityCenter()


'-----------------------------------------------------Connect to Quality Center --------------------------------------------------------


MsgBox "Starting Connectinon"
Dim qcURL As String
Dim qcID As String
Dim qcPWD As String
Dim qcDomain As String
Dim qcProject As String
Dim tdConnection As Object
Dim TestSetFact, tsTreeMgr, tSetFolder, TestSetsList, theTestSet
Dim TestSetIdentifier, TSTestFact, TestSetTestsList, testInstanceF, aFilter
Dim lst, tstInstance

On Error GoTo err
   qcURL = "Server Details/qcbin"
   qcID = "UserName"
   qcPWD = "Password"
   qcDomain = ""
   qcProject = ""

'Display a message in Status bar
 Application.StatusBar = "Connecting to Quality Center.. Wait..."
'Create a Connection object to connect to Quality Center
  Set tdConnection = CreateObject("TDApiOle80.TDConnection")
'Initialise the Quality center connection
   tdConnection.InitConnectionEx qcURL
'Authenticating with username and password
   tdConnection.Login qcID, qcPWD
'connecting to the domain and project
   tdConnection.Connect qcDomain, qcProject
'On successfull login display message in Status bar
  Application.StatusBar = "........QC Connection is done Successfully"
  MsgBox "Connection Established"


'---------------------------------------Connection Established --------------------------------------------------------------------------

'
' Get the test set tree manager from the test set factory
'tdconnection is the global TDConnection object.
Set TSetFact = tdConnection.TestSetFactory
Set tsTreeMgr = tdConnection.testsettreemanager
' Get the test set folder passed as an argument to the example code
nPath = Trim("Your Test Set Folder Path")

Set tsFolder = tsTreeMgr.NodeByPath(nPath)
--------------------------------Check if the Path Exists or NOt ---------------------------------------------------------------------
If tsFolder Is Nothing Then  
Msgbox "Error"
End If

' Search for the test set passed as an argument to the example code
Set tsList = tsFolder.FindTestSets("Test Set Name")
----------------------------------Check if the Test Set Exists --------------------------------------------------------------------
If tsList Is Nothing Then
Msgbox "Error"
End If

'---------------------------------------------Check if the TestSetExists or is Duplicated ----------------------------------------------

If tsList.Count > 1 Then
MsgBox "FindTestSets found more than one test set: refine search"
Exit Sub
ElseIf tsList.Count < 1 Then
MsgBox "FindTestSets: test set not found"
Exit Sub
End If

-------------------------------------------Access the Test Cases inside the Test SEt -------------------------------------------------

Set theTestSet = tsList.Item(1)

For Each testsetfound In tsList
Set tsFolder = testsetfound.TestSetFolder
Set tsTestFactory = testsetfound.tsTestFactory
Set tsTestList = tsTestFactory.NewList("")

For Each tsTest In tsTestList
MsgBox tsTest.Name
testrunname = "Test Case name"
If tsTest.Name = "Test case Name" Then

--------------------------------------------Accesss the Run Factory --------------------------------------------------------------------
Set RunFactory = tsTest.RunFactory
Set obj_theRun = RunFactory.AddItem(CStr(testrunname))
obj_theRun.Status = "Passed" '-- Status to be updated
obj_theRun.Post
End If
Next tsTest
Next testsetfound
'

'------------------------------------------------------Disconnect Quality Center -----------------------------------------------------------------

tdConnection.Disconnect
tdConnection.Logout
tdConnection.ReleaseConnection
MsgBox ("Logged Out")

-----------------------------------------Error Function to Display the Error in teh Excel Status Bar ---------------------------------------------

err:
'Display the error message in Status bar
Application.StatusBar = err.Description
 MsgBox "Some Error Pleas see ExcelSheet"


End Sub

使用VB从Excel更新测试实验室（qc）中的测试用例状态

1 个答案: