摘要: \'*****************************************************************************************************************\'名称：ReplaceAttachmentOnQC\'说明：替换QC服务器上指定对象（Test、TestSet或者Defect）的 ...
|
'*****************************************************************************************************************'名称：ReplaceAttachmentOnQC'说明：替换QC服务器上指定对象（Test、TestSet或者Defect）的附件'输入：' TestObject - QC上的对象：Test、TestSet或Defect' OldFileName - 待删除文件名' NewFileName - 待上传文件名（完全路径文件名，Full Path Name）'返回：' Bool类型，True代表替换附件成功，False代表替换附件失败'示例：ReplaceAttachmentOnQC QCUtil.CurrentTest, "data_file_attached.xls", "d:/temp/data_file_attached.xls"'设计人员：LYH'设计时间：08/10/23'*****************************************************************************************************************Public Function ReplaceAttachmentOnQC(TestObject, OldFileName, NewFileName)On Error Resume Next'初始化函数返回值ReplaceAttachmentOnQC = False'用Filter取得TestObject中符合FileName条件的附件Set AttachmentFactory = TestObject.AttachmentsSet AttachmentFilter = AttachmentFactory.Filter'由于QC中保存的附件名称前都添加了如Test_#_的前缀'需要对OldFileName进行处理，使Filter中使用的条件包含*OldFileName = Trim(OldFileName)If InStr(1, OldFileName, "*") = 1 ThenAttachmentFilter.Filter("CR_REFERENCE") = OldFileNameElseAttachmentFilter.Filter("CR_REFERENCE") = "*" & OldFileNameEnd If'从经过搜索的附件List中删除附件Set AttachmentList = AttachmentFactory.NewList(AttachmentFilter.Text)'如果找到一个或一个以上附件，取第一个附件删除并继续上传新文件If AttachmentList.Count > 0 ThenSet Attachment = AttachmentList.Item(1)AttachmentFactory.RemoveItem(Attachment.ID)'上传更新的附件ReplaceAttachmentOnQC = AddAttachmentOnQC(TestObject, NewFileName)Else'如果没有找到附件，返回False。不继续上传新文件ReplaceAttachmentOnQC = FalseEnd If'错误情况处理If Err.Number <> 0 ThenErr.ClearReplaceAttachmentOnQC = FalseOn Error GoTo 0End IfEnd Function
