QTP操作QC组件常用函数

这一篇文章用来描述QTP操作QC组件的常用函数，平时对QC的操作中可能会用到这些常用功能（代码比较长，慢慢看，要达到理解的目的）：

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

'名称：GetAttachmentFromQC

　　'说明：从QC服务器上的指定对象(Test、TestSet或者Defect)中找到指定名称的附件，下载到指定目录

　　'输入：

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

　　' FileName - 下载目标文件名(附件)

　　' DstFolder - 下载目标文件夹

　　'返回：

　　' Bool类型，True代表取附件成功，False代表取附件失败

　　'示例：GetAttachmentOnQC QCUtil.CurrentTest, "data_file_attached.xls", "d:/temp"

　　'***************************************************************************************　　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"

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

　　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)
　'返回：

　　' Bool类型，True代表替换附件成功，False代表替换附件失败

　　'示例：ReplaceAttachmentOnQC QCUtil.CurrentTest, "data_file_attached.xls", "d:/temp/data_file_attached.xls"

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

　　Public Function ReplaceAttachmentOnQC(TestObject, OldFileName, NewFileName)

　　On Error Resume Next

　　'初始化函数返回值

　　ReplaceAttachmentOnQC = False

　　'用Filter取得TestObject中符合FileName条件的附件

　　Set AttachmentFactory = TestObject.Attachments

　　Set AttachmentFilter = AttachmentFactory.Filter

　　'由于QC中保存的附件名称前都添加了如Test_#_的前缀

　　'需要对OldFileName进行处理，使Filter中使用的条件包含*

　　OldFileName = Trim(OldFileName)

　　If InStr(1, OldFileName, "*") = 1 Then

　　AttachmentFilter.Filter("CR_REFERENCE") = OldFileName

　　Else

　　AttachmentFilter.Filter("CR_REFERENCE") = "*" & OldFileName

　　End If

　　'从经过搜索的附件List中删除附件

　　Set AttachmentList = AttachmentFactory.NewList(AttachmentFilter.Text)

　　'如果找到一个或一个以上附件，取第一个附件删除并继续上传新文件

　　If AttachmentList.Count > 0 Then

　　Set Attachment = AttachmentList.Item(1)

　　AttachmentFactory.RemoveItem(Attachment.ID)

　　'上传更新的附件

　　ReplaceAttachmentOnQC = AddAttachmentOnQC(TestObject, NewFileName)

　　Else

　　'如果没有找到附件，返回False。不继续上传新文件

　　ReplaceAttachmentOnQC = False

　　End If

　　'错误情况处理

　　If Err.Number <> 0 Then

　　Err.Clear

　　ReplaceAttachmentOnQC = False

　　On Error GoTo 0

　　End If

　　End Function
　　'***************************************************************************************