Call createBug()
Function createBug()
Dim TDConnection
Dim htmlred
Dim Reporter
Set TDConnection = CreateObject("TDApiOle80.TDConnection")
TDConnection.InitConnectionEx ""
TDConnection.Login "", ""
TDConnection.Connect "", ""
If TDConnection.Connected Then
'MsgBox("Connected to " + chr (13) + "Server " + TDConnection.ServerName+ chr (13) +"Project " + TDConnection.ProjectName )
Else MsgBox("Not Connected")
End if
TDConnection.IgnoreHtmlFormat=true
Set BugFactory = TDConnection.BugFactory
Set fieldList = BugFactory.Fields
Set bugList = BugFactory.NewList("")
Set Excel = CreateObject("Excel.Application")
Excel.WorkBooks.Add
Set Sheet = Excel.ActiveSheet
Row = 1
Sheet.Cells(Row, 1).Value = "
BUG编号"
Sheet.Cells(Row, 2).Value = "
测试轮次"
Sheet.Cells(Row, 3).Value = "更新时间"
Sheet.Cells(Row, 4).Value = "记录时间"
Sheet.Cells(Row, 5).Value = "可否复现"
Sheet.Cells(Row, 6).Value = "BUG发现人"
Sheet.Cells(Row, 15).Value = "附件地址"
Row = 2
For Each Bug In BugList
Set attachFact = Bug.Attachments
Set attachList = attachFact.NewList("")
If attachList.count<>0 Then
Set attachObj = attachList.Item(1)
attachObj.Load True, "D:\Buglist\downloads"
Sheet.Cells(Row, 15).Value = attachObj.FileName
Sheet.Cells(Row, 15).Select
Sheet.Hyperlinks.Add Sheet.Cells(Row, 15), attachObj.FileName
else Sheet.Cells(Row, 15).Value = "无附件"
End If
Sheet.Cells(Row, 1).Value = Bug.id
Sheet.Cells(Row, 2).Value = Bug.field("BG_user_01")
Sheet.Cells(Row, 3).Value = Bug.field("BG_DETECTION_DATE")
Sheet.Cells(Row, 4).Value = Bug.field("BG_user_07")
Sheet.Cells(Row, 5).Value = Bug.field("BG_REPRODUCIBLE")
Sheet.Cells(Row, 6).Value = Bug.field("BG_DETECTED_BY")
Row = Row + 1
Next
Excel.ActiveWorkbook.SaveAs ("D:\Buglist\QualityCenter_DEFECTS.xls")
Excel.Quit
Set Excel = Nothing
Set BugList = Nothing
Set Bug=nothing
Set TDConnection=nothing
End Function