从QC下载测试脚本
' ==================================================================================
'
' Download Automation Tests from QC
'
' 1. get all folders, for each folder:
' a. check it has attachments or not. if yes, download its attachments to local folders
' b. check it has child folders. if yes, get child folders, for each child folder:
' b-1: check it has attachments or not. if yes, download to local folders
' 2. get all scripts under Test_Scripts:
' a. get all scripts under Test_Scripts folder
' b. check it has child folders, if yes, get child folders, for each child folder:
' b-1: check it has child folders, if yes, get child folders
' b-1-1: check it has test scripts, if yes, download them to local folders.
' b-2: check it has test scripts, if yes, download them to local folders.
'
' ==================================================================================
'
Dim qtApp 'As QuickTest.Application ' Declare the Application object variable
Dim blsSupportsVerCtrl ' Declare a flag for indicating version control support
Dim qcURL, qcDomain, qcProject, qcUser, qcPassword ' As String to login QC
Dim tdc 'As QC Connection object
Dim TreeMgr 'As TreeManager
Dim SubjRoot ' As SubjectNode
Dim SubNode ' As SubjectNode
Dim ScriptRoot 'As String
Dim RootName 'As String
Dim ScriptList 'As list
Dim fso 'As File System Object
Dim LocalAutomationPath 'As String
LocalAutomationPath = "C:\Automation\"
qcURL = ""
qcDomain = "DEFAULT"
qcProject = "ATLANTES"
qcUser = "xdu"
qcPassword = "1"
ScriptRoot = "Automation - ATLANTES"
Set fso = CreateObject("Scripting.FileSystemObject")
' Delete alreay existed Folder of this automation
'MsgBox LocalAutomationPath & ScriptRoot
If Not fso.FolderExists(LocalAutomationPath & ScriptRoot) Then
' fso.DeleteFolder(LocalAutomationPath & ScriptRoot)
fso.CreateFolder(LocalAutomationPath & ScriptRoot)
End If
Set fso = Nothing
' Connect QC and Project
Set tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx qcURL
tdc.Login qcUser, qcPassword
tdc.Connect qcDomain, qcProject
Set TreeMgr = tdc.TreeManager
Set Trees = TreeMgr.RootList(TDOLE_SUBJECT)
Set SubjRoot = TreeMgr.TreeRoot(Trees.Item(1))
Set SubNode = SubjRoot.FindChildNode(ScriptRoot) ' Find Automation Root
'MsgBox "Test:" & SubNode.Count
' -----------------------------------------------
'
' Get All Folders and Download their attachments
'
' -----------------------------------------------
Call DownloadAttachments(SubNode,LocalAutomationPath)
' -----------------------------------------------
' Get All Scripts Path
' -----------------------------------------------
Dim ScriptNode 'As Subject Node
Dim strScriptName 'As String
Dim arrayScript ' As Array
Set ScriptNode = SubNode.FindChildNode("Test_Scripts")
strScriptName = GetTestName(ScriptNode,"")
'Msgbox strScriptName
'--------------------------------------
' Release objects
'--------------------------------------
Set ScriptNode = Nothing
Set SubNode = Nothing
Set SubjRoot = Nothing
Set Trees = Nothing
Set TreeMgr = Nothing
tdc.Disconnect
tdc.Logout
tdc.ReleaseConnection
Set tdc = Nothing
'--------------------------------------
' Download Scripts from QC by QTP
'--------------------------------------
arrayScript = Split(strScriptName, ";")
Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object
qtApp.Launch ' Start QuickTest
qtApp.Visible = True ' Make the QuickTest application visible
'
' Make changes in a test on Quality Center with version control
qtApp.TDConnection.Connect qcURL,qcDomain, qcProject, qcUser, qcPassword, False ' Connect to Quality Center
If qtApp.TDConnection.IsConnected Then ' If connection is successful
blsSupportsVerCtrl = qtApp.TDConnection.SupportVersionControl ' Check whether the project supports version control
'For Each strScriptName in arrayScript
For i=0 To Ubound(arrayScript)
strScriptName = arrayScript(i)
If Trim(strScriptName) <> "" Then
qtApp.Open "[QualityCenter] Subject\" & ScriptRoot & strScriptName, False
If blsSupportsVerCtrl Then ' If the project supports version control
qtApp.Test.CheckOut ' Check out the test
End If
' MsgBox "No#" & i & " - " & LocalAutomationPath & "\" & ScriptRoot & strScriptName
qtApp.Test.SaveAs LocalAutomationPath & "\" & ScriptRoot & strScriptName, False
End If
'If i=10 Then
' Exit For
'End If
Next
' qtApp.Open "[QualityCenter] Subject\Login Issue", False ' Open the test
' If blsSupportsVerCtrl Then ' If the project supports version control
' qtApp.Test.CheckOut ' Check out the test
' End If
'
' qtApp.Test.SaveAs "C:\Login Issue" ' Save the test
'
qtApp.TDConnection.Disconnect ' Disconnect from Quality Center
Else
'MsgBox "Cannot connect to Quality Center" ' If connection is not successful, display an error message.
End If
qtApp.Quit ' Exit QuickTest
Set qtApp = Nothing ' Release the Application object
' -----------------------------------------------
'
' Get All Scripts Path and return it as String with ';' demilimer
'
' -----------------------------------------------
Function GetTestName(SubNode,strParentFolder)
Dim strTestFullPath ' As String
Dim strParentPath ' As String
Dim ChildNode ' As Subject Node
Dim ScriptTestList 'As Test Factory
strTestFullPath = ""
strParentPath = strParentFolder & "\"
' Get tests under current node
Set ScriptTestList = SubNode.TestFactory.NewList("")
For j=1 To ScriptTestList.Count
strTestFullPath = strTestFullPath & strParentPath & SubNode.Name & "\" & ScriptTestList.Item(j).Name & ";"
' Msgbox ScriptTestList.Item(j).Name
Next
Set ScriptTestList = Nothing
' Get Current Parent Folder path
'strParentFolder = strParentFolder & SubNode.Name & "\"
' Get all children nodes folder names
For i=1 To SubNode.Count
' Msgbox SubNode.Child(i).Name
Set ChildNode = SubNode.FindChildNode(SubNode.Child(i).Name)
strTestFullPath = strTestFullPath & GetTestName(ChildNode, strParentPath & SubNode.Name ) & ";" 'strParentFolder
Next
GetTestName = strTestFullPath
End Function
' -----------------------------------------------
'
' Create Local Folders and Download Attachments
'
' -----------------------------------------------
Sub DownloadAttachments(SubNode, strLocalRootFolderPath)
Dim LocalAutomationPath 'As String
Dim CurrentNodePath 'As String
Dim AttachmentName 'As String
Dim AttachFac ' As AttachmentFactory
Dim AttachObj 'As Attachment
Dim ExStrg ' As ExtendStorage
Dim AttachList ' As List
Dim ChildNode ' As Subject Node
Dim fso 'As File System Object
Set fso = CreateObject("Scripting.FileSystemObject")
'MsgBox SubNode.Child(i).Name
CurrentNodePath = strLocalRootFolderPath & "\" & SubNode.Name
If Not fso.FolderExists(CurrentNodePath) Then
fso.CreateFolder(CurrentNodePath)
End If
Set AttachFac = SubNode.Attachments
Set attachList = AttachFac.NewList("")
For Each AttachObj In attachList
Set ExStrg = AttachObj.AttachmentStorage
ExStrg.ClientPath = CurrentNodePath '& "\"' "C:\Test_Configuration\"
AttachmentName = AttachObj.Name(1) 'Mid(Trim(AttachObj.Name),16)
ExStrg.Load AttachObj.Name,True
If fso.FileExists(CurrentNodePath & "\" & AttachObj.Name) Then
fso.MoveFile CurrentNodePath & "\" & AttachObj.Name, CurrentNodePath & "\" & AttachmentName
End If
Set ExStrg = Nothing
Next
Set AttachObj = Nothing
Set attachList = Nothing
Set AttachFac = Nothing
For j=1 To SubNode.Count
' Msgbox SubNode.Child(i).Name
Set ChildNode = SubNode.FindChildNode(SubNode.Child(j).Name)
Call DownloadAttachments(ChildNode, CurrentNodePath)
Next
Set fso = Nothing
End Sub
