' ==========================================================
' 说明：ClearQuest不能发送带附件的邮件，该脚本可以实现在
' ClearQuest里执行某个Action后发送一封带附件的邮件。
' 前提：以Domino作为邮件服务器，执行该Action操作的人员
' 本地应装有Notes客户端，并能通过Notes客户端发送邮件
' 思想：执行Action时，将附件先下载到本地，然后通过调用
' Notes Com接口来实现带附件的邮件的发送
' 缺点：由于脚本里面无法得到每个人的邮箱密码，所以执行该Action
' 的人员在执行Action时，会提示输入自己的Notes邮箱密码。
' 功能扩展:虽然有以上缺陷,不过该脚本主要演示CQ里处理附件的方法,和通过Notes
' Com端口发送邮件的功能。通过以上的方法，可以是先很多报告功能，
' 可以把通过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
