将QC与VBA连接以从excel更新测试用例状态

时间:2015-09-30 13:09:23

标签: vba excel-vba vb6 qc vbe

我有一张excel表,第一列作为测试用例名,第二列作为测试状态。我想用这个Excel工作表编写一个VB代码,它将从NORUN更新我的状态 - >在Qc中通过/失败。

截至目前,我正在尝试使用以下代码导航到测试用例,但我无法检索当前状态,以便我可以更新它。 请帮我解决一下:找到我的代码

Sub ConnectToQualityCenter()

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 = "http://pntva30"
   qcID = ""
   qcPWD = ""
   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"

  'Set TSetFact = tdConnection.TestSetFactory
 ' MsgBox TSetFact
 ' Set tsTreeMgr = tdc.TestSetTreeManager
  'MsgBox tsTreeMgr

FldPath = "Root\MrinalTestFolder\Test1\Referencedatastandalone" '-- Test SetPath
TestSetName = "118-001 New share instrument sent to APTP" -- Test Set Name
Set TestSetFact = tdConnection.TestSetFactory
Set tsTreeMgr = tdConnection.TestSetTreeManager

Set tSetFolder = tsTreeMgr.NodeByPath(FldPath)
Set TestSetsList = tSetFolder.FindTestSets(TestSetName)
Set theTestSet = TestSetsList.Item(1)
TestSetIdentifier = theTestSet.ID
'MsgBox TestSetIdentifier
TestSetIdentifier = theTestSet.Name
MsgBox TestSetIdentifier

Set tfact = tdConnection.TestFactory
Set theTest = tfact.Item(1701) -- Test Case ID
MsgBox theTest.Name
MsgBox theTest.ID
MsgBox theTest.Type
MsgBox theTest.ExecStatus
'MsgBox theTest.Status


Status = theTest.Field("TS_STATUS")
MsgBox Status --- NOW this is where i am getting the problem i am unable to get the Present status of NO RUN and instead i am getting a pass status everytime.
I think it is returning me the previous run status

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


   Exit Sub

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

0 个答案:

没有答案