|
|
| 使用脚本轻松导出本周纪录 |
| 作者 yunshan 查看 7025 发表时间 2007/1/29 16:02 【论坛浏览】 |
使用脚本轻松导出本周纪录whdnvyf
whdnvyf
因为CQ中没有关于本周纪录查询的const，如TODAY，TOMORROW，YESTODAY等，也因此给很多人带来了不少麻烦。whdnvyf
既然不能在客户端中直接建立这种查询（有人提过在客户端中通过使用SQL来实现，但是这种SQL可能很复杂，并不是每个人都能掌握的），所以本人就想到了使用外部脚本来实现。whdnvyf
whdnvyf
思想：通过运行一个.vbs脚本，来查询本周纪录，并导出到Excel中。whdnvyf
whdnvyf
实现：以下是实现这一思想的脚本，把它save成一个.vbs文件，然后把其中的session.Logon部分根据自己的实际情况来做适当的更改，保存后，任何时候一运行，就能把本周（一般是星期一到当前系统时间）纪录保存到一个excel文件中，非常方便。whdnvyf
whdnvyf
' --------------------------------------------------------whdnvyf
' Script Name: Exprot_Weekly_Defects.vbswhdnvyf
' Author: yunshanwhdnvyf
' Create Date: 2007-1-28whdnvyf
'---------------------------------------------------------whdnvyf
whdnvyf
' Declare the global constantwhdnvyf
Public Const SUCCESS = 1whdnvyf
Public Const AD_BOOL_OP_AND = 1whdnvyf
Public Const AD_COMP_OP_EQ = 1whdnvyf
whdnvyf
Dim curDatewhdnvyf
Dim curWeekwhdnvyf
Dim intervalwhdnvyf
Dim strDatewhdnvyf
whdnvyf
' Get the current date and compute the strDatewhdnvyf
curWeek = DatePart("w", Now)whdnvyf
interval = (curWeek + 6) Mod 7whdnvyf
If interval = 0 Thenwhdnvyf
interval = 7whdnvyf
End Ifwhdnvyf
interval = interval - 1whdnvyf
strDate = DateAdd("d", -interval, Date)whdnvyf
whdnvyf
' The start date of this week is from monday, time initial is 00:00:00whdnvyf
strDate = strDate & " 00:00:00"whdnvyf
whdnvyf
Dim sessionwhdnvyf
Dim resultsetwhdnvyf
whdnvyf
' Login to the destination databasewhdnvyf
Set session = CreateObject("CLEARQUEST.SESSION")whdnvyf
session.UserLogon "admin", "", "cdi", AD_PRIVATE_SESSION, "cdi"whdnvyf
whdnvyf
' Build Query On defectwhdnvyf
Set resultset = session.BuildSQLQuery("select T1.id,T1.headline,T7.name,T1.priority, " &_whdnvyf
"T2.login_name,T1.submit_date from Defect T1,statedef T7,users T2 where T1.state = T7.id " &_whdnvyf
"and T1.owner = T2.dbid and Submit_Date between"&_ whdnvyf
" #"& strDate &"# and #"& curDate &"#")whdnvyf
whdnvyf
'resultset.EnableRecordCountwhdnvyf
resultset.Executewhdnvyf
whdnvyf
Dim xlsAppwhdnvyf
Dim newBookwhdnvyf
Dim newSheetwhdnvyf
whdnvyf
' Create Excel App and set property for the new filewhdnvyf
Set xlsApp = CreateObject("Excel.Application")whdnvyf
set newBook = xlsApp.Workbooks.Addwhdnvyf
with newBookwhdnvyf
.Title = "All this weeks defect"whdnvyf
.Subject = "ClearQuest"whdnvyf
.Activatewhdnvyf
End Withwhdnvyf
whdnvyf
' work with sheet1whdnvyf
Set newSheet = newBook.Worksheets("Sheet1")whdnvyf
newSheet.Visible = Truewhdnvyf
newSheet.Name = "Weekly Defects"whdnvyf
whdnvyf
' set column titlewhdnvyf
newSheet.Range("A1:F1").Value = Array("ID","Headline","State","Priority","Owner","Submit Date")whdnvyf
newSheet.Range("A1:F1").Font.Bold = Truewhdnvyf
whdnvyf
' set values for destination cellswhdnvyf
Dim iwhdnvyf
i = 2whdnvyf
Do While resultset.MoveNext = SUCCESSwhdnvyf
newSheet.Cells(i,1).Value = resultset.GetColumnValue(1)whdnvyf
newSheet.Cells(i,2).Value = resultset.GetColumnValue(2)whdnvyf
newSheet.Cells(i,3).Value = resultset.GetColumnValue(3)whdnvyf
newSheet.Cells(i,4).Value = resultset.GetColumnValue(4)whdnvyf
newSheet.Cells(i,5).Value = resultset.GetColumnValue(5)whdnvyf
newSheet.Cells(i,6).Value = resultset.GetColumnValue(6)whdnvyf
i = i + 1whdnvyf
Loopwhdnvyf
whdnvyf
' Save changes to the excelwhdnvyf
newBook.SaveAs("C:\WeeklyDefects.xls")whdnvyf
whdnvyf
' release the objectswhdnvyf
Set newSheet = Nothingwhdnvyf
newBook.Closewhdnvyf
Set newBook = Nothingwhdnvyf
xlsApp.Quitwhdnvyf
Set xlsApp = Nothingwhdnvyf
Set resultset = Nothingwhdnvyf
Set session = Nothingwhdnvyf
MsgBox "Finish exporting records!"whdnvyf
whdnvyf
' 大家可以在这个脚本的基础上作适当的改动，以扩展它的功能。whdnvyf
whdnvyf
'==================================================================whdnvyf
' 对以上脚本的升级whdnvyf
' Author: yunshanwhdnvyf
' Description: 改动部分用黑体标出whdnvyf
'==================================================================whdnvyf
Public Const SUCCESS = 1whdnvyf
Public Const AD_BOOL_OP_AND = 1whdnvyf
Public Const AD_COMP_OP_EQ = 1whdnvyf
Public Const AD_COMP_OP_BETWEEN = 9whdnvyf
whdnvyf
Dim curWeekwhdnvyf
Dim intervalwhdnvyf
Dim strDatewhdnvyf
whdnvyf
' Get the current date and compute the strDatewhdnvyf
curWeek = DatePart("w", Now)whdnvyf
interval = (curWeek + 6) Mod 7whdnvyf
If interval = 0 Thenwhdnvyf
interval = 7whdnvyf
End Ifwhdnvyf
interval = interval - 1whdnvyf
strDate = DateAdd("d", -interval, Date)whdnvyf
strDate = strDate & " 00:00:00"whdnvyf
whdnvyf
Dim sessionwhdnvyf
Dim qryObjwhdnvyf
Dim filterObjwhdnvyf
Dim resultsetwhdnvyf
Dim dateRangewhdnvyf
ReDim dateRange(1)whdnvyf
dateRange(0) = strDatewhdnvyf
' 修正了一个小错误，把dateRange(1) = Now 改成了dateRange(1) = Cstr(Now)，否则运行会出错。whdnvyf
dateRange(1) = Cstr(Now)whdnvyf
whdnvyf
whdnvyf
' Login to the destination databasewhdnvyf
Set session = CreateObject("CLEARQUEST.SESSION")whdnvyf
session.UserLogon "admin", "", "productDB", AD_PRIVATE_SESSION, "masterDB"whdnvyf
whdnvyf
' Build Query On defectwhdnvyf
Set qryObj = session.BuildQuery("defect")whdnvyf
qryObj.BuildField("id")whdnvyf
qryObj.BuildField("headline")whdnvyf
qryObj.BuildField("State")whdnvyf
qryObj.BuildField("priority")whdnvyf
qryObj.BuildField("owner")whdnvyf
qryObj.BuildField("Submit_Date")whdnvyf
Set node = qryObj.BuildFilterOperator(AD_BOOL_OP_AND)whdnvyf
node.BuildFilter "Submit_Date",AD_COMP_OP_BETWEEN, dateRangewhdnvyf
whdnvyf
Set resultset = session.BuildResultSet(qryObj)whdnvyf
whdnvyf
' resultset.EnableRecordCountwhdnvyf
resultset.Executewhdnvyf
whdnvyf
Dim xlsAppwhdnvyf
Dim newBookwhdnvyf
Dim newSheetwhdnvyf
whdnvyf
' Create Excel App and set property for the new filewhdnvyf
Set xlsApp = CreateObject("Excel.Application")whdnvyf
set newBook = xlsApp.Workbooks.Addwhdnvyf
with newBookwhdnvyf
.Title = "All this weeks defect"whdnvyf
.Subject = "ClearQuest"whdnvyf
.Activatewhdnvyf
End Withwhdnvyf
whdnvyf
' work with sheet1whdnvyf
Set newSheet = newBook.Worksheets("Sheet1")whdnvyf
newSheet.Visible = Truewhdnvyf
newSheet.Name = "Weekly Defects"whdnvyf
whdnvyf
' set column titlewhdnvyf
With newSheet.Range("A1:F1")whdnvyf
.Value = Array("ID","Headline","State","Priority","Owner","Submit Date")whdnvyf
.Font.Bold = Truewhdnvyf
.Font.Color = vbWhitewhdnvyf
.Interior.ColorIndex = 1whdnvyf
End Withwhdnvyf
whdnvyf
' set values for destination cellswhdnvyf
Dim iwhdnvyf
i = 2whdnvyf
Do While resultset.MoveNext = SUCCESSwhdnvyf
newSheet.Cells(i,1).Value = resultset.GetColumnValue(1)whdnvyf
newSheet.Cells(i,2).Value = resultset.GetColumnValue(2)whdnvyf
newSheet.Cells(i,3).Value = resultset.GetColumnValue(3)whdnvyf
newSheet.Cells(i,4).Value = resultset.GetColumnValue(4)whdnvyf
newSheet.Cells(i,5).Value = resultset.GetColumnValue(5)whdnvyf
newSheet.Cells(i,6).Value = resultset.GetColumnValue(6)whdnvyf
i = i + 1whdnvyf
Loopwhdnvyf
whdnvyf
newSheet.Columns("A:F").AutoFitwhdnvyf
newBook.SaveAs("C:\WeeklyDefects.xls")whdnvyf
whdnvyf
newBook.Closewhdnvyf
Set newBook = Nothingwhdnvyf
xlsApp.Quitwhdnvyf
Set xlsApp = Nothingwhdnvyf
Set resultset = Nothingwhdnvyf
Set session = Nothingwhdnvyf
whdnvyf
[ 本帖最后由 yunshan 于 2007-10-24 18:48 编辑 ] |
| 序号 |
评论者 |
共有评论 30 【论坛浏览】 【发表评论】 |
评论时间 |
|
| 21 |
selina |
楼主，
在xls文件上加时间
这样改有点问题哟
提示如下 |
2007/3/16 12:28 |
|
| 22 |
selina |
没问题
刚才出现的这个错误提示，
是我把vb和perl搞混了
把注释用#表示的
这个文件上加上时间是没问题的 |
2007/3/16 12:31 |
|
| 23 |
yunshan |
回复 #23 selina 的帖子
我刚才也测试了一遍，的确是没有问题的:D |
2007/3/16 12:50 |
|
| 24 |
ylblue0213 |
使用这个脚本这个功能确实很实用,可以清楚的了解一周以来的工作,
不错!!!!!!! |
2007/3/20 18:46 |
|
| 25 |
sandwich |
把查询到的某一些值进行修改后,再导入到CQ中,如何写代码?谢谢.
请问楼主:
把查询到的某一些值进行修改后,再导入到CQ中,如何写代码?谢谢.
能否举例说明,谢谢. |
2007/8/30 15:04 |
|
| 26 |
yunshan |
回复 #26 sandwich 的帖子
我已经在你的这个帖子中，给你的这个问题做了答复，遍历的过程中就对记录进行修改，
http://bbs.scmlife.com/thread-6779-1-1.html |
2007/8/30 15:39 |
|
| 27 |
nowo |
| 引用: | 原帖由 yunshan 于 2007-1-29 16:45 发表
客户端中只能定义一个固定的查询，如2007-1-22到2007-1-27，但是如果到了下周，这个查询时间必须手动更改，就是因为目前CQ还没有提供适当的查询常量。 |
|
错误。
可以在 SQL 中取本周的第一天，然后 + 7 即为本周时间范围，无需一直修改。如：
between dateadd(wk,datediff(wk,0,getutcdate()-7),0) and (dateadd(wk,datediff(wk,0,getutcdate()),0))
这是查上周的时间范围。 |
2007/9/28 11:39 |
|
| 28 |
yunshan |
回复 #28 nowo 的帖子
nowo，
你可能没有仔细看吧，我在脚本中写的是不论一周中哪天运行脚本都可以导出本周缺陷记录的。 |
2007/9/28 16:30 |
|
| 29 |
star123 |
为什么我导出的数据是空的？我运行脚本前还新建了一个defect |
2007/9/29 09:48 |
|
| 30 |
yunshan |
回复 #30 star123 的帖子
你可能并没有修改好脚本，
我前面已经说了，要使用这个脚本必须做相应的改动，否则达不到预期的效果。 |
2007/9/29 12:58 |
共有评论数 30 每页显示 10
|
|
