QTP中对QC附件操作的几个函数

  1. '***************************************************************************************************************** 
  2. '名称：GetAttachmentFromQC  
  3. '说明：从QC服务器上的指定对象（Test、TestSet或者Defect）中找到指定名称的附件，下载到指定目录  
  4. '输入：  
  5. '                                TestObject - QC上的对象：Test、TestSet或Defect  
  6. '                                FileName - 下载目标文件名（附件）  
  7. '                                DstFolder - 下载目标文件夹  
  8. '返回：  
  9. '                                Bool类型，True代表取附件成功，False代表取附件失败  
  10. '示例：GetAttachmentOnQC QCUtil.CurrentTest, "data_file_attached.xls", "d:/temp"  
  11. '设计人员：LYH  
  12. '设计时间：08/10/23  
  13. '***************************************************************************************************************** 
  14. Public Function GetAttachmentOnQC(TestObject, FileName, DstFolder)  
  15.    On Error Resume Next  
  16.    '初始化函数返回值  
  17.    GetAttachmentOnQC = False  
  18.   
  19.    '为DstFolder变量添加路径斜杠"/"  
  20.    If Right(DstFolder, 1) <> "/" Then  
  21.            DstFolder = DstFolder & "/"  
  22.    End If  
  23.      
  24.    '取得AttachmentList对象，即TestObject的所有附件  
  25.         Set AttachmentFactory = TestObject.Attachments  
  26.         Set AttachmentList = AttachmentFactory.NewList("SELECT * FROM CROS_REF")  
  27.           
  28.         '先删除本地的文件.  
  29.         Set fso = CreateObject("Scripting.FileSystemObject")  
  30.         If fso.FileExists(DstFolder & Filename) then  
  31.                 fso.DeleteFile DstFolder & Filename   '删除文件  
  32.         End if  
  33.         Set fso = Nothing  
  34.           
  35.         '遍历TestObject对象的所有附件，找到名称为FileName的附件。附件  
  36.         For Each Attachment in AttachmentList  
  37.                 If InStr(1,Attachment.Name, FileName, 1) >= 1 Then  
  38.                         Set AttachmentStorage = Attachment.AttachmentStorage  
  39.                         AttachmentStorage.ClientPath=DstFolder  
  40.                         AttachmentStorage.Load Attachment.Name,True  
  41.             '下载后重命名，去掉QC附件前缀。类似Test_#_Filename  
  42.                         RenameFile DstFolder & Attachment.Name, DstFolder & Filename  
  43.                         GetAttachmentOnQC = True  
  44.             Exit Function  
  45.                 End If  
  46.         Next  
  47.   
  48.         '错误情况处理  
  49.         If Err.Number <> 0 Then  
  50.                 Err.Clear  
  51.                 GetAttachmentOnQC = False  
  52.                 On Error GoTo 0  
  53.         End If  
  54. End Function  
  55.   
  56. '***************************************************************************************************************** 
  57. '名称：AddAttachmentOnQC  
  58. '说明：向QC服务器上的指定对象（Test、TestSet或者Defect）中添加附件  
  59. '输入：  
  60. '                                TestObject - QC上的对象：Test、TestSet或Defect  
  61. '                                FileName - 上传目标文件名（完全路径文件名，Full Path Name）  
  62. '返回：  
  63. '                                Bool类型，True代表上传附件成功，False代表上传附件失败  
  64. '示例：AddAttachmentOnQC QCUtil.CurrentTest, "d:/temp/data_file_attached.xls"  
  65. '设计人员：LYH  
  66. '设计时间：08/10/23  
  67. '***************************************************************************************************************** 
  68. Public Function AddAttachmentOnQC(TestObject, FileName)  
  69.    On Error Resume Next  
  70.   
  71.    '初始化函数返回值  
  72.    AddAttachmentOnQC = False  
  73.   
  74.    '通过AddItem(Null)方法取得Attachment对象  
  75.         Set AttachmentFactory = TestObject.Attachments  
  76.         Set Attachment = AttachmentFactory.AddItem(Null)  
  77.           
  78.         '上传文件并更新  
  79.         Attachment.FileName = FileName  
  80.         Attachment.Type = 1  
  81.         Attachment.Post  
  82.         Attachment.Refresh  
  83.         AddAttachmentOnQC = True  
  84.   
  85.         '错误情况处理  
  86.         If Err.Number <> 0 Then  
  87.                 Err.Clear  
  88.                 GetAttachmentOnQC = False  
  89.                 On Error GoTo 0  
  90.         End If          
  91. End Function  
  92.   
  93. '***************************************************************************************************************** 
  94. '名称：ReplaceAttachmentOnQC  
  95. '说明：替换QC服务器上指定对象（Test、TestSet或者Defect）的附件  
  96. '输入：  
  97. '                                TestObject - QC上的对象：Test、TestSet或Defect  
  98. '                                OldFileName - 待删除文件名  
  99. '                                NewFileName - 待上传文件名（完全路径文件名，Full Path Name）  
  100. '返回：  
  101. '                                Bool类型，True代表替换附件成功，False代表替换附件失败  
  102. '示例：ReplaceAttachmentOnQC QCUtil.CurrentTest, "data_file_attached.xls", "d:/temp/data_file_attached.xls"  
  103. '设计人员：LYH  
  104. '设计时间：08/10/23  
  105. '***************************************************************************************************************** 
  106. Public Function ReplaceAttachmentOnQC(TestObject, OldFileName, NewFileName)  
  107.    On Error Resume Next  
  108.      
  109.    '初始化函数返回值  
  110.    ReplaceAttachmentOnQC = False  
  111.   
  112.    '用Filter取得TestObject中符合FileName条件的附件  
  113.         Set AttachmentFactory = TestObject.Attachments  
  114.         Set AttachmentFilter = AttachmentFactory.Filter  
  115.   
  116.         '由于QC中保存的附件名称前都添加了如Test_#_的前缀  
  117.         '需要对OldFileName进行处理，使Filter中使用的条件包含*  
  118.         OldFileName = Trim(OldFileName)  
  119.         If InStr(1, OldFileName, "*")  = 1 Then  
  120.                 AttachmentFilter.Filter("CR_REFERENCE") = OldFileName  
  121.         Else  
  122.                 AttachmentFilter.Filter("CR_REFERENCE") = "*" & OldFileName  
  123.         End If  
  124.   
  125.         '从经过搜索的附件List中删除附件  
  126.         Set AttachmentList = AttachmentFactory.NewList(AttachmentFilter.Text)  
  127.         '如果找到一个或一个以上附件，取第一个附件删除并继续上传新文件  
  128.         If AttachmentList.Count > 0 Then  
  129.                 Set Attachment = AttachmentList.Item(1)  
  130.                 AttachmentFactory.RemoveItem(Attachment.ID)  
  131.                 '上传更新的附件  
  132.                 ReplaceAttachmentOnQC = AddAttachmentOnQC(TestObject, NewFileName)  
  133.         Else  
  134.         '如果没有找到附件，返回False。不继续上传新文件          
  135.                 ReplaceAttachmentOnQC = False  
  136.         End If  
  137.   
  138.         '错误情况处理  
  139.         If Err.Number <> 0 Then  
  140.                 Err.Clear  
  141.                 ReplaceAttachmentOnQC = False  
  142.                 On Error GoTo 0  
  143.         End If          
  144. End Function  
posted @ 2011-11-07 20:13  Sirrah  阅读(756)  评论(0)  编辑  收藏  举报