先说明下我的实现方式和思路，能实现该程序要感谢本论坛实现时间预先警的一个帖子。该程序已经在公司内部正式使用，
这个程序可以实现给当前处理人和关注该流程的人员发邮件，并且将发送邮件的部分专门写成一个函数。
而邮件邮箱列表可以是从项目信息里得到，也可以从Group里实现。由于可以理解的原因，我去掉了程序中的一些实际信息。
另外，对于CQ写script，大家可以经常访问IBM网站：
http://www-128.ibm.com/developerworks/rational/library/4236.html可以得到很多启发。
=====================================================
' CQ自动预警邮件脚本
' ******* 创建此脚本
' =====================================================
' 功能说明：
' 本脚本实现在版本计划发布时间快到的前两天预警，
' 自动邮件提醒当前处理人尽快处理。
' 各项目让配置管理员和项目经理知悉，并让技术管理组人员
' 知悉全部需要预警的信息
' =====================================================
' 使用说明：
' 需将本脚本保存为vbs格式设置为计划任务定时（如凌晨2点）执行，
' 要求执行脚本的机器上已经安装有CQ
' =====================================================
' BoolOp Constants
Const booOp_and = 1 ' and
Const booOp_or = 2 'or
' CompOp Constants
Const comOp_eq = 1 ' =
Const comOp_neq = 2 ' <>
Const comOp_lt = 3 '<
Const comOp_lte = 4 '<=
Const comOp_gt = 5 '>
Const comOp_gte = 6 ' >=
' Other Constants
Const SUCCESS = 1 ' 存在下一个记录
' 以下常量根据实用应用环境设置
Const worn_sta = "已发布" ' 预警状态
Const login_name = "admin" ' 管理员登录名
Const password = "***"
Const db_name = "****" ' 要访问的数据库名
' 即使什么都不做，也需要创建一个session，作用是取得CQ中的邮件规则
set session = CreateObject("CLEARQUEST.SESSION")
' 请确保你的帐号能够访问目标数据库，下面的注释是UserLogon的函数原型
' session.UserLogon login_name, password, database_name, session_type, database_set
session.UserLogon login_name, password, db_name, AD_PRIVATE_SESSION, ""
' 建立类型记录查询
Set querydef = session.BuildQuery("版本发布")
' 若邮件内容还需要其他该记录的字段，则在这里添加
querydef.BuildField("ID")
QueryDef.BuildField("State")
querydef.BuildField("项目")
querydef.BuildField("发布版本")
querydef.BuildField("当前处理人")
Querydef.BuildField("配置管理员")
QueryDef.BuildField("计划发布日期")
QueryDef.BuildField("RecordWeblink")
NowTime= FormatDateTime(Now,vbShortDate) '现在的日期
FutTime= FormatDateTime(DateAdd("d",2, Now),vbShortDate) '与现在相比后两天日期
OldTime= FormatDateTime(DateAdd("d",-60, Now),vbShortDate) '过去两个月的日期
' 设置过滤条件
Set operator = querydef.BuildFilterOperator(booOp_and)
' 查找所有当前状态不等于"已发布"的版本发布流程
operator.BuildFilter "State", comOp_neq, worn_sta
Set Operator1=Operator.BuildFilterOperator(booOp_and)
operator1.BuildFilter "计划发布日期",comOp_gte,OldTime
operator1.BuildFilter "计划发布日期",comOp_lt,FutTime
Set resultSetObj = session.BuildResultSet(querydef)
resultSetObj.Execute
j=0
nBody=nBody & vbCrLf & "以下是版本计划发布日期的快到期版本发布流程详细列表："
mBody=mBody & vbCrLf & "以下是已经超过版本计划发布日期的版本发布流程详细列表："
Do While resultSetObj.MoveNext = SUCCESS
' 设定邮件标题
project= resultSetObj.GetcolumnValue(3)
Curuser= resultSetObj.GetcolumnValue(5)
mFrom="cqadmin@********"
PlanTimeStr=resultSetObj.GetColumnValue(7)
PlanTime=FormatDateTime(PlanTimeStr,vbShortDate)
n=DateDiff("d",PlanTime,NowTime)
If n>0 Then
mSub ="【CQ温馨提示】您是版本发布流程" & resultSetObj.GetColumnValue(1) & "的当前处理人，该版本已经超过计划发布日期" & n & "天，请尽快处理。"
Else
mSub ="【CQ温馨提示】您是版本发布流程" & resultSetObj.GetColumnValue(1) & "的当前处理人，该版本还有" & abs(n) & "天就到计划发布日期，请尽快处理。"
End If
CMName= GetProjFieldValue(Session,Project,"配置管理员")
PMName= GetProjFieldValue(Session,Project,"项目经理")
UserStr=CMName & ";" & PMName
mTo=GetUserMailStr(Session,Curuser,";")
mCcStr=GetUserMailStr(Session,UserStr,";")
mCc=Split(mCcStr,";")
sBody="该版本详细信息为如下："
sBody=sBody & vbCrLf & "版本ID为：" & resultSetObj.GetColumnValue(1)
sBody=sBody & vbCrLf & "状态为：" & resultSetObj.GetcolumnValue(2)
sBody=sBody & vbCrLf & "项目为：" & project
sBody=sBody & vbCrLf & "发布版本为：" & resultSetObj.GetcolumnValue(4)
sBody=sBody & vbCrLf & "当前处理人为：" & resultSetObj.GetcolumnValue(5)
sBody=sBody & vbCrLf & "配置管理员为：" & resultSetObj.GetcolumnValue(6)
sBody=sBody & vbCrLf & "计划发布日期为：" & PlanTimeStr
sBody=sBody & vbCrLf & "详情请查看:" & " " & resultSetObj.GetColumnValue(8)
If n>0 Then
mBody=mBody & vbCrLf & "============================================================="
mBody=mBody & vbCrLf & "版本ID为：" & resultSetObj.GetColumnValue(1)
mBody=mBody & vbCrLf & "状态为：" & resultSetObj.GetcolumnValue(2)
mBody=mBody & vbCrLf & "项目为：" & project
mBody=mBody & vbCrLf & "发布版本为：" & resultSetObj.GetcolumnValue(4) & "，已经超期" & n & "天！"
mBody=mBody & vbCrLf & "当前处理人为：" & resultSetObj.GetcolumnValue(5)
mBody=mBody & vbCrLf & "配置管理员为：" & resultSetObj.GetcolumnValue(6)
mBody=mBody & vbCrLf & "计划发布日期为：" & PlanTimeStr
mBody=mBody & vbCrLf & "详情请查看:" & " " & resultSetObj.GetColumnValue(8)
mBody=mBody & vbCrLf & "============================================================="
Else
nBody=nBody & vbCrLf & "============================================================="
nBody=nBody & vbCrLf & "版本ID为：" & resultSetObj.GetColumnValue(1)
nBody=nBody & vbCrLf & "状态为：" & resultSetObj.GetcolumnValue(2)
nBody=nBody & vbCrLf & "项目为：" & project
nBody=nBody & vbCrLf & "发布版本为：" & resultSetObj.GetcolumnValue(4) & "，还有" & Abs(n) & "天到期！"
nBody=nBody & vbCrLf & "当前处理人为：" & resultSetObj.GetcolumnValue(5)
nBody=nBody & vbCrLf & "配置管理员为：" & resultSetObj.GetcolumnValue(6)
nBody=nBody & vbCrLf & "计划发布日期为：" & PlanTimeStr
nBody=nBody & vbCrLf & "详情请查看:" & " " & resultSetObj.GetColumnValue(8)
nBody=nBody & vbCrLf & "============================================================="
End If
call sendmail(mFrom,mTo,mCc,"",mSub,sBody)
Loop
mFrom="cqadmin@********"
mSub ="【CQ温馨提示】邮件内容是过去两个月内超过计划发布时间，而版本流程还未结束的版本及快到计划发布日期的版本，各版本已经通知当前处理人处理"
userlist=GetUserListFromGroup(Session,"技术管理组")
For i=0 to Ubound(Userlist)
If i=0 Then
UserStr=Userlist(i)
Else
UserStr=UserStr & ";" & UserList(i)
End If
Next
mTostr=GetUserMailStr(Session,UserStr,";")
mTo=Split(mTostr,";")
mBody=mBody & vbCrLf & vbCrLf & vbCrLf & vbCrLf & nBody
call sendmail(mFrom,mTo,"","",mSub,mBody)
' **********************************************
' 增加从项目名称取得项目信息里某个域的值的函数
' Author:**** Date:2007-01-09
' ***********************************************
Function GetProjFieldValue(Session,ProjectName,FieldName)
' 根据传入的项目名称和字段名称，取得该项目中该字段的值并返回该值
Const booOp_and = 1 ' and
Const comOp_eq = 1 ' =
Const SUCCESS = 1
Set Queryproj = Session.BuildQuery("项目")
Queryproj.BuildField(FieldName)
Set Operatorproj = queryproj.BuildFilterOperator(booOp_and)
operatorproj.BuildFilter "项目名称", comOp_eq, ProjectName
Set resultSetproj = Session.BuildResultSet(queryproj)
resultSetproj.Execute
If resultSetproj.MoveNext = SUCCESS Then
FieldValue = resultSetproj.GetColumnValue(1)
GetProjFieldValue=FieldValue
End If
End Function
' **********************************************
' 增加从一个组里取得该组所有人员的全局函数
' Author:**** Date:2006-12-20
' ***********************************************
Function GetUserListFromGroup(Session,Group)
Dim operation
Dim Querydef
Dim resultset
Dim username
dim filternode1
Const comOp_eq = 1 ' =
Const SUCCESS = 1 ' 存在下一个记录
set querydef = session.BuildQuery("users")
querydef.BuildField("login_name")
set filternode1 = querydef.BuildFilterOperator(AD_BOOL_OP_AND)
filternode1.BuildFilter "groups.name", comOp_eq , Group
set resultset = session.BuildResultSet(querydef)
resultset.Execute
i=0
While resultSet.MoveNext=SUCCESS
ReDim Preserve TempArray(i)
username = resultset.GetColumnValue(1)
TempArray(i)=username
i=i+1
Wend
GetUserListFromGroup = TempArray
End Function
' *********************************************************
' 增加从名字字符串返回用户所对应的邮箱字符串
' Author:**** Date:2006-12-26
' *********************************************************
Function GetUserMailStr(Session,UserStr,Delimiter)
' UserStr--名字字符串,Delimiter--以其未分隔符的字符串
Const booOp_and = 1 ' and
Const comOp_eq = 1 ' =
Const comOp_gte = 6 ' <=
const comOp_neq = 2 ' <>
Const SUCCESS = 1 ' 存在下一个记录
MailStr=""
If UserStr<>"" Then
UserList=Split(UserStr,Delimiter)
flag="False"
For i=0 To Ubound(UserList)
set query = session.BuildQuery("users")
query.BuildField("email")
set filterObj = query.BuildFilterOperator(booOp_and)
filterobj.BuildFilter "login_name", comOp_eq, UserList(i)
set resultset = session.BuildResultSet(query)
resultset.Execute
If resultset.MoveNext = SUCCESS Then
If flag="False" Then
MailStr=resultSet.GetColumnValue(1)
Flag="True"
Else
MailStr=MailStr & ";" & resultSet.GetColumnValue(1)
End If
End If
Next
End If
GetUserMailStr=MailStr
End Function
' **********************************************
' 增加发送邮件的全局函数
' Author:**** Date:2006-12-26
' **********************************************
Sub SendMail(mFrom,mTo,mCc,mBcc,mSub,mBody)
' mFrom--邮件发送人
' mTo--邮件主送人员
' mCC--邮件抄送人员
' mBcc--邮件密送人员
' mSub--邮件标题
' mBody--邮件正文
set msg = CreateObject("PAINET.MAILMSG")
msg.SetFrom mFrom
' 添加主送列表
If Not IsArray(mTO) Then
If mTo<>"" Then
msg.AddTo mTO
End If
Else
For i=0 to ubound(mTo)
msg.AddTo mTo(i)
Next
End If
' 添加抄送列表
If Not IsArray(mCc) Then
If mCc<>"" Then
msg.AddCc mCc
End If
Else
For i=0 to ubound(mCc)
msg.AddCc mCc(i)
Next
End If
' 添加密送列表
If Not IsArray(mBcc) Then
If mBcc<>"" Then
msg.AddBcc mBcc
End If
Else
For i=0 to ubound(mBcc)
msg.AddBcc mBcc(i)
Next
End If
msg.SetSubject mSub
msg.SetBody mBody
msg.Deliver
set msg = Nothing
End Sub
