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

发表于:2012-07-25来源:Csdn作者:tulituqi点击数: 标签:qtp
这是以前指导过我的一个专家给我的代码,发出来给大家分享一下。作用和用法请查看代码里的注释。

  这是以前指导过我的一个专家给我的代码,发出来给大家分享一下。作用和用法请查看代码里的注释。

  [vb] view plaincopyprint?

  '******************************************************************************************************************************************

  '名称: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

  '******************************************************************************************************************************************

  '名称:ReplaceAttachmentOnQC

  '说明:替换QC服务器上指定对象(Test、TestSet或者Defect)的附件

  '输入:

  ' TestObject - QC上的对象:Test、TestSet或Defect

  ' OldFileName - 待删除文件名

  ' NewFileName - 待上传文件名(完全路径文件名,Full Path Name)

原文转自:http://www.ltesting.net