'***************************************************************************************************************** '名称：GetAttachmentFromQC '说明：从QC服务器上的指定对象（Test、TestSet或者Defect）中找到指定名称的附件，下载到指定目录 '输入： ' TestObject - QC上的对象：Test、TestSet或Defect ' FileName - 下载目标文件名（附件） ' DstFolder - 下载目标文件夹 '返回： ' Bool类型，True代表取附件成功，False代表取附件失败 '示例：GetAttachmentOnQC QCUtil.CurrentTest, "data_file_attached.xls", "d:/temp" '设计人员：LYH '设计时间：08/10/23 '***************************************************************************************************************** Public Function GetAttachmentOnQC(TestObject, FileName, DstFolder) On Error Resume Next '初始化函数返回值 GetAttachmentOnQC = False '为DstFolder变量添加路径斜杠"/" If Right(DstFolder, 1) <> "/" Then DstFolder = DstFolder & "/" End If '取得AttachmentList对象，即TestObject的所有附件 Set AttachmentFactory = TestObject.Attachments Set AttachmentList = AttachmentFactory.NewList("SELECT * FROM CROS_REF") '先删除本地的文件. Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(DstFolder & Filename) then fso.DeleteFile DstFolder & Filename '删除文件 End if Set fso = Nothing '遍历TestObject对象的所有附件，找到名称为FileName的附件。附件 For Each Attachment in AttachmentList If InStr(1,Attachment.Name, FileName, 1) >= 1 Then Set AttachmentStorage = Attachment.AttachmentStorage AttachmentStorage.ClientPath=DstFolder AttachmentStorage.Load Attachment.Name,True '下载后重命名，去掉QC附件前缀。类似Test_#_Filename RenameFile DstFolder & Attachment.Name, DstFolder & Filename GetAttachmentOnQC = True Exit Function End If Next '错误情况处理 If Err.Number <> 0 Then Err.Clear GetAttachmentOnQC = False On Error GoTo 0 End If End Function '***************************************************************************************************************** '名称：AddAttachmentOnQC '说明：向QC服务器上的指定对象（Test、TestSet或者Defect）中添加附件 '输入： ' TestObject - QC上的对象：Test、TestSet或Defect ' FileName - 上传目标文件名（完全路径文件名，Full Path Name） '返回： ' Bool类型，True代表上传附件成功，False代表上传附件失败 '示例：AddAttachmentOnQC QCUtil.CurrentTest, "d:/temp/data_file_attached.xls" '设计人员：LYH '设计时间：08/10/23 '***************************************************************************************************************** Public Function AddAttachmentOnQC(TestObject, FileName) On Error Resume Next '初始化函数返回值 AddAttachmentOnQC = False '通过AddItem(Null)方法取得Attachment对象 Set AttachmentFactory = TestObject.Attachments Set Attachment = AttachmentFactory.AddItem(Null) '上传文件并更新 Attachment.FileName = FileName Attachment.Type = 1 Attachment.Post Attachment.Refresh AddAttachmentOnQC = True '错误情况处理 If Err.Number <> 0 Then Err.Clear GetAttachmentOnQC = False On Error GoTo 0 End If End Function |
