后台邮件通知功能

QualityCenter自带的邮件发送配置功能实在是不好用：
1）邮件发送标题不够直观，不能明确缺陷处理阶段
2）邮件发送延时现象及其严重，甚至有时候会丢失

鉴于以上两个原因，特意在后台重写了邮件通知功能，新建了两个方法
1)GetInfo
 负责查找需要发送责任人的邮件地址
2)SendMail
 调用GetInfo方法，并利用BugFactory对象获取Bug的具体信息，并发送邮件
3)完成后在Defects_Bug_AfterPost过程中调用SendMail即可

在后台实现的邮件通知功能效率明显高于配置，10S内就能接收到通知邮件，且标题一目了然

代码：

Function GetInfo(User,Psw,DSource,DBase,SqlStr)
         'Dim rs,conn,sqlstr,strcon
         StrCon = "Provider=sqloledb;User ID="&User &_
             ";Password="&Psw &_
             ";Data source="&DSource &_
             ";DATABASE="&DBase

         Set Conn = createobject("adodb.connection")
         Conn.open StrCon

         Set Rs=createobject("adodb.recordset")
         Rs.open SqlStr,Conn,1,1

         If NOT(Rs.BOF = True And Rs.EOF = True) Then
           'RsCount = Rs.Fields.Count
           'For i = 0 To RsCount - 1
             Info = Rs.Fields(0).value
           'Next
         End If

         GetInfo = Info

         set Rs = Nothing
         Set Conn = Nothing
End Function

Sub SendMail()
         On Error Resume Next

         UserId = "xxx"
         PWord = "xxx"
         DataSource = "xxx"
         DataBase = "qcsiteadmin_db"

         Id = Bug_Fields("BG_BUG_ID").Value

         Set ōbjBugFactory = TDConnection.BugFactory
         'set BugFilter = ObjBugFactory.Filter

         'BugFilter.Filter("BG_BUG_ID") = Id
         set ōbjBug = ObjBugFactory.Item(Id)

         'set BugList = BugFilter.NewList

         'For each ObjBug in BugList

         '获取项目
         PojName = TDConnection.ProjectName

         StrComment = ""

         '已提交
         If ((Bug_Fields("BG_USER_01").Value = "已提交") And _
            (Bug_Fields("BG_RESPONSIBLE").IsModified))Then

            '设置邮件接收人和标题
            UName = ObjBug.Field("BG_RESPONSIBLE")

            'msgbox UName

            Sql = "select EMAIL from td.USERS where USER_NAME = "&"'"&UName&"'"

            'msgbox Sql

            StrTo = GetInfo(UserId,PWord,DataSource,DataBase,Sql)

            'Msgbox StrTo

            StrCc = ""
            StrSubject = PojName&":您有新分配的缺陷"&"(ID:"&Id&")"& _
                         "，请及时修改！"

            '发送邮件
            ObjBug.Mail StrTo, StrCc, TDMAIL_TEXT, StrSubject, StrComment

         End If

         '未修复－修改状态未更改责任人
         If ((Bug_Fields("BG_USER_01").IsModified) And _
             (Bug_Fields("BG_USER_01").Value = "未修复"))Then

            '设置邮件接收人和标题
            UName = ObjBug.Field("BG_RESPONSIBLE")

            Sql = "select EMAIL from td.USERS where USER_NAME = "&"'"&UName&"'"

            StrTo = GetInfo(UserId,PWord,DataSource,DataBase,Sql)

            StrCc = ""
            StrSubject = PojName&":您修改的缺陷"&"(ID:"&Id&")"& _
                         "验证未通过！"

            '发送邮件
            ObjBug.Mail StrTo, StrCc, TDMAIL_TEXT, StrSubject, StrComment

         End If

         '未修复－未改状态但更改责任人
         If ((Bug_Fields("BG_RESPONSIBLE").IsModified) And _
             (Bug_Fields("BG_USER_01").Value = "未修复"))Then

            '设置邮件接收人和标题
            UName = ObjBug.Field("BG_RESPONSIBLE")

            Sql = "select EMAIL from td.USERS where USER_NAME = "&"'"&UName&"'"

            StrTo = GetInfo(UserId,PWord,DataSource,DataBase,Sql)

            StrCc = ""
            StrSubject = PojName&":您有新分配的缺陷"&"(ID:"&Id&")"& _
                         "，请及时修改！"

            '发送邮件
            ObjBug.Mail StrTo, StrCc, TDMAIL_TEXT, StrSubject, StrComment

         End If

         '待验证
         If ((Bug_Fields("BG_USER_01").IsModified) And _
             (Bug_Fields("BG_USER_01").Value = "待验证"))Then

            '设置邮件接收人和标题
            UName = ObjBug.Field("BG_DETECTED_BY")

            Sql = "select EMAIL from td.USERS where USER_NAME = "&"'"&UName&"'"

            StrTo = GetInfo(UserId,PWord,DataSource,DataBase,Sql)

            StrCc = ""
            StrSubject = PojName&":您提交的缺陷"&"(ID:"&Id&")"& _
                         "已修改完成，请及时验证！"

            '发送邮件
            ObjBug.Mail StrTo, StrCc, TDMAIL_TEXT, StrSubject, StrComment

         End If

         '已驳回
         If ((Bug_Fields("BG_USER_01").IsModified) And _
             (Bug_Fields("BG_USER_01").Value = "已驳回"))Then

    '设置邮件接收人和标题
            UName = ObjBug.Field("BG_DETECTED_BY")

            Sql = "select EMAIL from td.USERS where USER_NAME = "&"'"&UName&"'"

            StrTo = GetInfo(UserId,PWord,DataSource,DataBase,Sql)

            StrCc = ""
            StrSubject = PojName&":您提交的缺陷"&"(ID:"&Id&")"& _
                         "被驳回，请关注！"

            '发送邮件
            ObjBug.Mail StrTo, StrCc, TDMAIL_TEXT, StrSubject, StrComment

         End If

         'Next

         Set ōbjBug = Nothing
         Set ōbjBugFactory = Nothing

         On Error GoTo 0
End Sub