通过CQ Hook 发送带附件的邮件

hasjing

在CQ Hook里实现发送带附件的邮件

' ==========================================================
' 说明：ClearQuest不能发送带附件的邮件，该脚本可以实现在 ，ClearQuest里执行某个Action后发送一封带附件的邮件。
' 前提：以Domino作为邮件服务器，执行该Action操作的人员 本地应装有Notes客户端，并能通过Notes客户端发送邮件
思想：执行Action时，将附件先下载到本地，然后通过调用 Notes Com接口来实现带附件的邮件的发送
' 缺点：由于脚本里面无法得到每个人的邮箱密码，所以执行该Action 的人员在执行Action时，会提示输入自己的Notes邮箱密码。
' 功能扩展:虽然有以上缺陷,不过该脚本主要演示CQ里处理附件的方法,和通过NotesCom端口发送邮件的功能。通过以上的方法，可以是写很多报告功能，可以把通过Notes发送邮件的脚本写成一个vbs脚本文件，这个时候就可以把Notes密码直接写入脚本来发送邮件。放到服务器上，并且建立一个计划任务比如一周，一个月，定时执行，发送附件。 而附件的内容可以是通过CQ查询出的某种报告，如未完成的基线，未完成的版本流程。 可以把这些报告存成Excel表格式，（具体实现参见yunshan 的《 使用脚本轻松导出本周纪录》）然后发送给相关人员（相关人员邮件列表取的的方式可参见本人另外一个帖子）。
' Author: killer215        Date:2007-2-2
' ==========================================================

' 下面脚本以Action为"Test",Hook为Notification
Sub Test_Notification(ActionName,ActionType)
        Dim entityObj
        Dim attachmentsObj
        Dim attachment
        Dim FileName,FilePath
        Set attachField =AttachmentFields.Item(0)
        Set attachmentsObj = attachField.Attachments
        numAttachments = attachmentsobj.Count - 1
        Redim FilePathArray(0)
        FilePathArray(0)=""
        For i = 0 to numAttachments
                set attachment = attachmentsObj.Item(i)
                FileName=attachment.FileName
                ' 调用GetFilePath函数得到正确的下载路径
                FilePath=GetFilePath(FileName)
                ' 将附件下载到FilePath指定的路径
                Attachment.Load(FilePath)
                Redim Preserve FilePathArray(i)
                FilePathArray(i)=Filepath
        Next
        ' 调用通过Notes客户端发送邮件的函数发送邮件
        ' 由于该脚本主要说明附件的发送，所以在SendNotesMail里面除了取
        ' CQ里记录类型的附件外，没有取其他信息，如果需要其他信息也容易
        ' 加入
        Call SendNotesMail(FilePathArray)
End Sub

' **************************************************************
' 以下函数应该写在Global Scripts里，这里多说一句，在以前的编程中，为了代码的简洁，
' 我会把一些常用的代码抽出为一个函数，然后其他代码调用，但在CQ里写全局函数要谨慎，
' 我的建议是，能不用就不用，即使牺牲一点代码简洁。具体原因我会在以后的一篇关于CQ
' 调优的文档里说明。
' **************************************************************

' =============================================================
' 增加得到下载附件到本机的文件路径，如果没有该目录，则创建
' 如果该文件已经存在，则先删除该文件的函数
' Author:killer215         Date:2007-2-2
' =============================================================
Function GetFilePath(FileName)
   Dim FilePath,FileDirectory
   FileDirectory="C:\Temp"
   Dim fs
   Set fs = CreateObject("Scripting.FileSystemObject")
   ' 如果目录不存在，则创建该目录
   If Not fs.FolderExists(FileDirectory) Then
     fs.CreateFolder(FileDirectory)
   End If
   Filepath=FileDirectory & "\" & FileName
   ' 如果文件已经存在，则删除该文件
   If fs.FileExists(FilePath) Then
      Dim file
      Set file = fs.GetFile(FilePath)
      File.Delete
   End If
   GetFilePath=FilePath
End Function


' ===========================================
' 增加通过Notes客户端发送邮件的函数
' Author:killer215      Date:2007-1-26
' ===========================================
Function SendNotesMail(FilePathArray)
  Dim Notesobj,dir,db,doc,item
  Dim mailsrv,email_address,tolist,body,FileName
  '创建一个Notes Com端口实例
  Set notesobj = CreateObject("Lotus.NotesSession")
  notesobj.Initialize
  ' 从本地的notes.ini文件得到邮件服务器，并且打开自己邮件数据库
  mailsrv = notesobj.GetEnvironmentString("MailServer", True)
  set dir = notesobj.GetDbDirectory(mailsrv)
  set db = dir.OpenMailDatabase
  If db.IsOpen Then
        '创建一封新的邮件
        set doc = db.CreateDocument
        doc.ReplaceItemValue "Form", "Memo"
        ' 在这里添加邮件地址，这个信息可以从记录类型的当前处理人，和项目信息里
        ' 取得，如配置管理员，项目经理，测试人员邮箱等。
        email_address="****@**.**.**"
        tolist = split(email_address,",",-1,1)
        doc.ReplaceItemValue "SendTo", tolist
        doc.ReplaceItemValue "Subject", "测试通过notes接口发送带附件的邮件"
        body = "通过ClearQuest发送带附件邮件的测试" & vbCrLf & vbCrLf
        set item = doc.CreateRichTextItem("Body")
        item.AppendText(body)
        If FilePathArray(0)<>"" Then
      For i=0 To ubound(FilePathArray)
             item.EmbedObject 1454, "", FilePathArray(i)
          Next
        End If
        doc.Send(False)
  End If
End Function