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

　　'名稱：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)

　　'返回：

　　' 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.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

原文轉自：http://www.anti-gravitydesign.com