用Excel VBA连接QC，并下载Test Case的代码

事实上，这样的功能在安装了QC的Excel插件后，会自动安装到Excel根目录下面一个下载工具，在excel 的add-in里可以看到.

但是由于种种原因,导致很多朋友无法正常使用该功能,在此将代码附加如下,仅供参考(实测可用)

Option Explicit
Public QCConnection

'Return the TDConnection object.

Public Sub ExportTC()

Const xlLeft = -4131
Const xlRight = -4152
Const xlCenter = -4108
Const xlGeneral = 1

Set QCConnection = CreateObject("TDApiOle80.TDConnection")
Dim sUserName, sPassword
sUserName = "YuanZifan.com" '-- 填写用户名
sPassword = "YuanZiFan.com" '-- 填写密码

QCConnection.InitConnectionEx "http://qualityCenter.yuanzifan.com/qcbin/" '-- 填写QC地址，写到QC BIN即可

QCConnection.Login sUserName, sPassword

If (QCConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
'WScript.Quit
End If

Dim sDomain, sProject
sDomain = "YZFXXX"  '填写QC域信息
sProject = "YZFXXXX"  '填写项目信息

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

End Sub

Function PrintFields(oObject)
Dim FieldsList, Field
Set FieldsList = oObject.Fields

For Each Field In FieldsList
WScript.Echo Field
Next
End Function

Function ExportTestCases()
Dim TestFactory, TestList

'Set TestFactory = QCConnection.TestFactory
Dim tree, node

Set tree = QCConnection.TreeManager
Set node = tree.NodeByPath("Subject\ProjectName\FolderName") ' -- 修改此处
Set TestFactory = node.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of specified folder.

Dim TestCase, 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, 8) = "Expected Result"

'Call PrintFields(TestFactory)

Dim Row
Row = 2
'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

'Call PrintFields(DesignStepFactory)

Excel.Columns.AutoFit

'Save the newly created workbook and close Excel.
Excel.ActiveWorkbook.SaveAs ("C:\Case Download\TestCase.xls") '存储位置

Excel.Quit
End Function