QTP中對QC附件操作的幾個函數

　　這是以前指導過我的一個專家給我的代碼，發出來給大家分享一下。作用和用法請查看代碼里的注釋。

　　[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.anti-gravitydesign.com