|
首页
>> 配置管理
>> IBM Rational ClearQuest / ClearDDTS/TestManager
|
| 使用脚本轻松导出本周纪录 |
| 作者 yunshan 查看 6209 发表时间 2007/1/29 16:02 【论坛浏览】 |
使用脚本轻松导出本周纪录waflzfm
waflzfm
因为CQ中没有关于本周纪录查询的const，如TODAY，TOMORROW，YESTODAY等，也因此给很多人带来了不少麻烦。waflzfm
既然不能在客户端中直接建立这种查询（有人提过在客户端中通过使用SQL来实现，但是这种SQL可能很复杂，并不是每个人都能掌握的），所以本人就想到了使用外部脚本来实现。waflzfm
waflzfm
思想：通过运行一个.vbs脚本，来查询本周纪录，并导出到Excel中。waflzfm
waflzfm
实现：以下是实现这一思想的脚本，把它save成一个.vbs文件，然后把其中的session.Logon部分根据自己的实际情况来做适当的更改，保存后，任何时候一运行，就能把本周（一般是星期一到当前系统时间）纪录保存到一个excel文件中，非常方便。waflzfm
waflzfm
' --------------------------------------------------------waflzfm
' Script Name: Exprot_Weekly_Defects.vbswaflzfm
' Author: yunshanwaflzfm
' Create Date: 2007-1-28waflzfm
'---------------------------------------------------------waflzfm
waflzfm
' Declare the global constantwaflzfm
Public Const SUCCESS = 1waflzfm
Public Const AD_BOOL_OP_AND = 1waflzfm
Public Const AD_COMP_OP_EQ = 1waflzfm
waflzfm
Dim curDatewaflzfm
Dim curWeekwaflzfm
Dim intervalwaflzfm
Dim strDatewaflzfm
waflzfm
' Get the current date and compute the strDatewaflzfm
curWeek = DatePart("w", Now)waflzfm
interval = (curWeek + 6) Mod 7waflzfm
If interval = 0 Thenwaflzfm
interval = 7waflzfm
End Ifwaflzfm
interval = interval - 1waflzfm
strDate = DateAdd("d", -interval, Date)waflzfm
waflzfm
' The start date of this week is from monday, time initial is 00:00:00waflzfm
strDate = strDate & " 00:00:00"waflzfm
waflzfm
Dim sessionwaflzfm
Dim resultsetwaflzfm
waflzfm
' Login to the destination databasewaflzfm
Set session = CreateObject("CLEARQUEST.SESSION")waflzfm
session.UserLogon "admin", "", "cdi", AD_PRIVATE_SESSION, "cdi"waflzfm
waflzfm
' Build Query On defectwaflzfm
Set resultset = session.BuildSQLQuery("select T1.id,T1.headline,T7.name,T1.priority, " &_waflzfm
"T2.login_name,T1.submit_date from Defect T1,statedef T7,users T2 where T1.state = T7.id " &_waflzfm
"and T1.owner = T2.dbid and Submit_Date between"&_ waflzfm
" #"& strDate &"# and #"& curDate &"#")waflzfm
waflzfm
'resultset.EnableRecordCountwaflzfm
resultset.Executewaflzfm
waflzfm
Dim xlsAppwaflzfm
Dim newBookwaflzfm
Dim newSheetwaflzfm
waflzfm
' Create Excel App and set property for the new filewaflzfm
Set xlsApp = CreateObject("Excel.Application")waflzfm
set newBook = xlsApp.Workbooks.Addwaflzfm
with newBookwaflzfm
.Title = "All this weeks defect"waflzfm
.Subject = "ClearQuest"waflzfm
.Activatewaflzfm
End Withwaflzfm
waflzfm
' work with sheet1waflzfm
Set newSheet = newBook.Worksheets("Sheet1")waflzfm
newSheet.Visible = Truewaflzfm
newSheet.Name = "Weekly Defects"waflzfm
waflzfm
' set column titlewaflzfm
newSheet.Range("A1:F1").Value = Array("ID","Headline","State","Priority","Owner","Submit Date")waflzfm
newSheet.Range("A1:F1").Font.Bold = Truewaflzfm
waflzfm
' set values for destination cellswaflzfm
Dim iwaflzfm
i = 2waflzfm
Do While resultset.MoveNext = SUCCESSwaflzfm
newSheet.Cells(i,1).Value = resultset.GetColumnValue(1)waflzfm
newSheet.Cells(i,2).Value = resultset.GetColumnValue(2)waflzfm
newSheet.Cells(i,3).Value = resultset.GetColumnValue(3)waflzfm
newSheet.Cells(i,4).Value = resultset.GetColumnValue(4)waflzfm
newSheet.Cells(i,5).Value = resultset.GetColumnValue(5)waflzfm
newSheet.Cells(i,6).Value = resultset.GetColumnValue(6)waflzfm
i = i + 1waflzfm
Loopwaflzfm
waflzfm
' Save changes to the excelwaflzfm
newBook.SaveAs("C:\WeeklyDefects.xls")waflzfm
waflzfm
' release the objectswaflzfm
Set newSheet = Nothingwaflzfm
newBook.Closewaflzfm
Set newBook = Nothingwaflzfm
xlsApp.Quitwaflzfm
Set xlsApp = Nothingwaflzfm
Set resultset = Nothingwaflzfm
Set session = Nothingwaflzfm
MsgBox "Finish exporting records!"waflzfm
waflzfm
' 大家可以在这个脚本的基础上作适当的改动，以扩展它的功能。waflzfm
waflzfm
'==================================================================waflzfm
' 对以上脚本的升级waflzfm
' Author: yunshanwaflzfm
' Description: 改动部分用黑体标出waflzfm
'==================================================================waflzfm
Public Const SUCCESS = 1waflzfm
Public Const AD_BOOL_OP_AND = 1waflzfm
Public Const AD_COMP_OP_EQ = 1waflzfm
Public Const AD_COMP_OP_BETWEEN = 9waflzfm
waflzfm
Dim curWeekwaflzfm
Dim intervalwaflzfm
Dim strDatewaflzfm
waflzfm
' Get the current date and compute the strDatewaflzfm
curWeek = DatePart("w", Now)waflzfm
interval = (curWeek + 6) Mod 7waflzfm
If interval = 0 Thenwaflzfm
interval = 7waflzfm
End Ifwaflzfm
interval = interval - 1waflzfm
strDate = DateAdd("d", -interval, Date)waflzfm
strDate = strDate & " 00:00:00"waflzfm
waflzfm
Dim sessionwaflzfm
Dim qryObjwaflzfm
Dim filterObjwaflzfm
Dim resultsetwaflzfm
Dim dateRangewaflzfm
ReDim dateRange(1)waflzfm
dateRange(0) = strDatewaflzfm
' 修正了一个小错误，把dateRange(1) = Now 改成了dateRange(1) = Cstr(Now)，否则运行会出错。waflzfm
dateRange(1) = Cstr(Now)waflzfm
waflzfm
waflzfm
' Login to the destination databasewaflzfm
Set session = CreateObject("CLEARQUEST.SESSION")waflzfm
session.UserLogon "admin", "", "productDB", AD_PRIVATE_SESSION, "masterDB"waflzfm
waflzfm
' Build Query On defectwaflzfm
Set qryObj = session.BuildQuery("defect")waflzfm
qryObj.BuildField("id")waflzfm
qryObj.BuildField("headline")waflzfm
qryObj.BuildField("State")waflzfm
qryObj.BuildField("priority")waflzfm
qryObj.BuildField("owner")waflzfm
qryObj.BuildField("Submit_Date")waflzfm
Set node = qryObj.BuildFilterOperator(AD_BOOL_OP_AND)waflzfm
node.BuildFilter "Submit_Date",AD_COMP_OP_BETWEEN, dateRangewaflzfm
waflzfm
Set resultset = session.BuildResultSet(qryObj)waflzfm
waflzfm
' resultset.EnableRecordCountwaflzfm
resultset.Executewaflzfm
waflzfm
Dim xlsAppwaflzfm
Dim newBookwaflzfm
Dim newSheetwaflzfm
waflzfm
' Create Excel App and set property for the new filewaflzfm
Set xlsApp = CreateObject("Excel.Application")waflzfm
set newBook = xlsApp.Workbooks.Addwaflzfm
with newBookwaflzfm
.Title = "All this weeks defect"waflzfm
.Subject = "ClearQuest"waflzfm
.Activatewaflzfm
End Withwaflzfm
waflzfm
' work with sheet1waflzfm
Set newSheet = newBook.Worksheets("Sheet1")waflzfm
newSheet.Visible = Truewaflzfm
newSheet.Name = "Weekly Defects"waflzfm
waflzfm
' set column titlewaflzfm
With newSheet.Range("A1:F1")waflzfm
.Value = Array("ID","Headline","State","Priority","Owner","Submit Date")waflzfm
.Font.Bold = Truewaflzfm
.Font.Color = vbWhitewaflzfm
.Interior.ColorIndex = 1waflzfm
End Withwaflzfm
waflzfm
' set values for destination cellswaflzfm
Dim iwaflzfm
i = 2waflzfm
Do While resultset.MoveNext = SUCCESSwaflzfm
newSheet.Cells(i,1).Value = resultset.GetColumnValue(1)waflzfm
newSheet.Cells(i,2).Value = resultset.GetColumnValue(2)waflzfm
newSheet.Cells(i,3).Value = resultset.GetColumnValue(3)waflzfm
newSheet.Cells(i,4).Value = resultset.GetColumnValue(4)waflzfm
newSheet.Cells(i,5).Value = resultset.GetColumnValue(5)waflzfm
newSheet.Cells(i,6).Value = resultset.GetColumnValue(6)waflzfm
i = i + 1waflzfm
Loopwaflzfm
waflzfm
newSheet.Columns("A:F").AutoFitwaflzfm
newBook.SaveAs("C:\WeeklyDefects.xls")waflzfm
waflzfm
newBook.Closewaflzfm
Set newBook = Nothingwaflzfm
xlsApp.Quitwaflzfm
Set xlsApp = Nothingwaflzfm
Set resultset = Nothingwaflzfm
Set session = Nothingwaflzfm
waflzfm
[ 本帖最后由 yunshan 于 2007-10-24 18:48 编辑 ] |
|
7:: :