Re: BackUp QTP scripts stored in Quality Center (6752 Views)
Reply
Advisor
goodyf9
Posts: 24
Registered: ‎12-28-2009
Message 1 of 13 (6,752 Views)
Accepted Solution

BackUp QTP scripts stored in Quality Center

Hi All,

I have gone through few threads related to this topic but dint find exact answer for the way I needed so I'm opening a new thread.

I need to take backups of the QTP scripts that are stored in Quality center .I need to take back up by browsing the Folder and test cases with in the folder to local drive.

In the below script I'm saving single script by giving the path.But the way I need is to browse by folder and save all Test cases of that folder on local drive .

Any suggestions or help highly appreciated

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 "serverpath", "DomainName", "ProjectName", "Username", "password", False ' Connect to Quality Center

If qtApp.TDConnection.IsConnected Then
qtApp.Open "[QualityCenter] Subject\QTPFOLDER\QTPSCRIPTS\Testcase1", False ' Open the test
qtApp.Test.SaveAs "K:\QATestCases\QTPSCRIPTS"
End If

set qtApp=nothing
Trusted Contributor
Percy Bell
Posts: 348
Registered: ‎09-18-2008
Message 2 of 13 (6,752 Views)

Re: BackUp QTP scripts stored in Quality Center

If you want to be able to browse by folder then you will need to code in something that will allow you to create a folder tree gui. You can use VB.Net to do that. You would need to use the OTA API to get the Tree from QC in order for you to navigate it.

I created a script that would export all QTP test cases from a specific subject node and all subnodes. You can then run your script as a function on all the files to export all test cases.
Advisor
goodyf9
Posts: 24
Registered: ‎12-28-2009
Message 3 of 13 (6,752 Views)

Re: BackUp QTP scripts stored in Quality Center

Thanks for the reply Percy !!
Can you please share your code !!
I got you what you're saying !!I'm new to OTA API so I'm not sure what methods exactly I have to use for accessing the sub-folders of QC and save then to local drive
Trusted Contributor
Percy Bell
Posts: 348
Registered: ‎09-18-2008
Message 4 of 13 (6,752 Views)

Re: BackUp QTP scripts stored in Quality Center

I'm feeling generous today. Here's my script. I have functions to export file attachments for folders in QC. This is because I have library functions and datafiles in QC. The tests would not work if I did not download these attachments as well.

Option Explicit

'==========================================================================
'
' Quality Center QTP Test Case Exporter
'
' NAME: DownloadQTPFromQC.vbs
'
' AUTHOR: Percy Bell
' DATE : 2/5/2009
'
'
' PURPOSE:
' To export all QTP Test Cases from QC for a given Test Plan Root Node.
'
'==========================================================================

'Quality Center Server settings
Dim strUserName, strPassword, strServer
strUserName = "" '<-- Change me.
strPassword = "" '<-- Change me.
strServer = "http://qc:8080/qcbin/" '<-- Change me.

'Quality Center Project settings
Dim strDomain, strProject, strRootNode
strDomain = "" '<-- Change me.
strProject = "" '<-- Change me.
strRootNode = "Subject\" '<-- Change me.

'Return the TDConnection object.
Dim TDConnection
Set TDConnection = CreateObject("TDApiOle80.TDConnection")

'Login to Quality Center
TDConnection.InitConnectionEx strServer
TDConnection.Login strUserName, strPassword

If (TDConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
WScript.Quit
End If

'Connect to Project
TDConnection.Connect strDomain, strProject

'Get array of user created QTPTestClass objects
Dim arrObjQTPTests
arrObjQTPTests = GetQTPTestsFromQC(strRootNode)

'Get attachments
'Call GetAttachmentsFromFolderByExt(strRootNode, "*.vbs", "C:\Automation\")
'Call GetAttachmentsFromFolderByExt(strRootNode, "*.qfl", "C:\Automation\")
'Call GetAttachmentsFromFolderByExt(strRootNode, "*.xls", "C:\Automation\")

'Close Quality Center Connection
TDConnection.Disconnect
TDConnection.Logout
TDConnection.ReleaseConnection

Set TDConnection = Nothing

'Save QTP Test from array of QTP tests in QC
Call SaveQTPTests(arrObjQTPTests)



'-----------------------------
' Function Library
'-----------------------------
'Region Function Libary


'''
''' Start QTP load test from array and save test locally in same folder structure as QC.
'''

''' Array of QTPTestClass objects.
Public Sub SaveQTPTests(ByRef arrObjQTPTests)
'Create QTP object to control QTP
Dim qtApp
Set qtApp = CreateObject("QuickTest.Application")

'If connection not already established then establish connection(QTP already running)
If Not qtApp.TDConnection.IsConnected Then
qtApp.TDConnection.Connect strServer, strDomain, strProject, strUserName, strPassword, False
End If

qtApp.Launch ' Start QuickTest
qtApp.Visible = False ' Make the QuickTest application invisible

'Get each QTP test's name and path to load and save.
Dim objQTPTest
For Each objQTPTest In arrObjQTPTests
If qtApp.TDConnection.IsConnected Then ' If connection is successful
Dim strQCTestPath, strLocalTestPath, strLocalTestFolder
strQCTestPath = "[QualityCenter] " & objQTPTest.Path & "\" & objQTPTest.Name
strLocalTestPath = "C:\" & objQTPTest.Path & "\" & objQTPTest.Name
strLocalTestFolder = "C:\" & objQTPTest.Path

WScript.Echo "Open test from QC: " & strQCTestPath
qtApp.Open strQCTestPath, True ' Open test in read only mode

WScript.Echo "Create local folder: " & strLocalTestFolder
CreateFolderPath(strLocalTestFolder) ' Create folder including parent folders.

WScript.Echo "Save Test as: " & strLocalTestPath & vbcrlf
qtApp.Test.SaveAs strLocalTestPath ' Save test to local path.

Else
MsgBox "Cannot connect to Quality Center" ' If connection is not successful, display an error message.
End If
Next

qtApp.TDConnection.Disconnect ' Disconnect from Quality Center
qtApp.Quit ' Exit QuickTest

Set qtApp = Nothing
End Sub



'''
''' Gets the name and path of QTP tests for the give node in QC's Test Plan Module.
'''

''' string
''' Array of QTPTestClass objects for the given QC Node and subnodes.
Public Function GetQTPTestsFromQC(ByVal strRootNode)
'Gets subnodes of the given root node.
Dim arrStrNodesList
arrStrNodesList = GetNodesList(strRootNode)

Dim arrObjQTPTest(), intNewUpper
intNewUpper = 0

'Get all QTP test for each of the given nodes in the node list.
Dim strNode
For Each strNode In arrStrNodesList
Dim objTreeManager, objSubjectNode, objTestFactory, objTDFilter
Set objTreeManager = TDConnection.TreeManager
Set objSubjectNode = objTreeManager.NodeByPath(strNode)
Set objTestFactory = objSubjectNode.TestFactory
Set objTDFilter = objTestFactory.Filter
objTDFilter("TS_TYPE") = "= 'QUICKTEST_TEST'"

Dim objTestList
Set objTestList = objTestFactory.NewList(objTDFilter.Text)

'Get the name and path for each of the QTP tests in the test list.
Dim objTest
For Each objTest In objTestList
ReDim Preserve arrObjQTPTest(intNewUpper)
Set arrObjQTPTest(intNewUpper) = New QTPTestClass

'Create a QTPTestClass to make setting and getting the path and name easier.
arrObjQTPTest(intNewUpper).Path = objSubjectNode.Path
arrObjQTPTest(intNewUpper).Name = objTest.Name

intNewUpper = intNewUpper + 1
Next
Next

'Cleanup objects
Set objTest = Nothing
Set objTestList = Nothing
Set objTDFilter = Nothing
Set objTestFactory = Nothing
Set objSubjectNode = Nothing
Set objTreeManager = Nothing

GetQTPTestsFromQC = arrObjQTPTest
End Function



'''
''' Returns an array for all children of a given Node of a tree.
'''

''' strNode in a Test Lab tree.
''' Array of subnodes paths for the given QC root node.
Public Function GetNodesList(ByVal RootNode)
'Specify Array to contain all nodes of subject tree.
Dim arrStrNodesList()
ReDim Preserve arrStrNodesList(0)
arrStrNodesList(0) = RootNode

Dim objTreeManager, objSubjectNode
Set objTreeManager = TDConnection.TreeManager
Set objSubjectNode = objTreeManager.NodeByPath(RootNode)

'Run on all children nodes
Dim i, intNewUpper
For i = 1 To objSubjectNode.Count
'If current node has a child then get path on child nodes too.
If objSubjectNode.Child(i).Count >= 1 Then
Dim arrStrTempNodeList
arrStrTempNodeList = GetNodesList(objSubjectNode.Child(i).Path)

Dim strNode
For Each strNode In arrStrTempNodeList
'Add more space to dynamic array
intNewUpper = UBound(arrStrNodesList) + 1
ReDim Preserve arrStrNodesList(intNewUpper)

'Add strNode path to array
arrStrNodesList(intNewUpper) = strNode
Next
Else
'Add more space to dynamic array
intNewUpper = UBound(arrStrNodesList) + 1
ReDim Preserve arrStrNodesList(intNewUpper)

'Add strNode path to array
arrStrNodesList(intNewUpper) = objSubjectNode.Child(i).Path
End If
Next

' Cleanup objects
Set objSubjectNode = Nothing
Set objTreeManager = Nothing

WScript.Echo("Found " & UBound(arrStrNodesList) + 1 & " subnodes for Root Node """ & RootNode & """ including Root Node.")

GetNodesList = arrStrNodesList
End Function



'''
''' Moves the designated file.
'''

''' The fully qualified name of the source file to be moved.
''' The fully qualified name of the destination file.
''' True to overwrite destination file.
''' Value will be True if file was renamed; False if not.
Public Function MoveFile(ByVal strSourceFile, ByVal strDestinationFile, ByVal blnOverwrite)
Dim blnRetVal
blnRetVal = False

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

'If overwrite flag set then delete already existing file so rename will succeed.
If (objFSO.FileExists(strDestinationFile) = True) And (blnOverwrite = True) Then
objFSO.DeleteFile(strDestinationFile)
End If

On Error Resume Next
objFSO.MoveFile strSourceFile, strDestinationFile
If Err.Number <> 0 Then
Wscript.Echo "Error in moving file: " & Err.Number
Wscript.Echo "Error (Hex): " & Hex(Err.Number)
Wscript.Echo "Source: " & Err.Source
Wscript.Echo "Description: " & Err.Description

blnRetVal = False
Else
blnRetVal = True
End If
Err.Clear()
On Error GoTo 0

Set objFSO = Nothing

MoveFile = blnRetVal
End Function



'''
''' Creates a file system folder including parent folders
'''

''' The fully qualified directory of folders to create.
''' True is returned if the folders were sucessfully created; False if not.
Function CreateFolderPath(ByVal strFolderPath)
Dim blnRetVal
blnRetVal = False

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Input checking
If strFolderPath <> "" Then
'If the folder doesn't exist then recursively create parent folder
If objFSO.FolderExists(strFolderPath) = False Then
If CreateFolderPath(objFSO.GetParentFolderName(strFolderPath)) = True Then
On Error Resume Next
objFSO.CreateFolder(strFolderPath)
If Err.Number <> 0 Then
Wscript.Echo "Error in creating folder: " & Err.Number
Wscript.Echo "Error (Hex): " & Hex(Err.Number)
Wscript.Echo "Source: " & Err.Source
Wscript.Echo "Description: " & Err.Description
Wscript.Echo "Folder to create: " & strFolderPath

blnRetVal = False
Else
blnRetVal = True
End If
Err.Clear
On Error GoTo 0
End If
Else
'Folder exists.
blnRetVal = True
End If
Else
'Either root folder or no path sent.
blnRetVal = False
End If

Set objFSO = Nothing

CreateFolderPath = blnRetVal
End Function



'''
''' Provides a nice container for QTP tests Names and Paths.
'''

Class QTPTestClass
Private strName
Private strPath

'Set and Get for Name
Property Get Name
Name = strName
End Property

Property Let Name(sName)
strName = sName
End Property

'Set and Get for Path
Property Get Path
Path = strPath
End Property

Property Let Path(sPath)
strPath = sPath
End Property
End Class



'''
''' Retrieves an attachment from any test plan folder
'''

''' The folder that contains the attachment.
''' The file name of the attachment.
''' The path to which to save the file.
''' Path including filename of the attachment on the local filesystem.
Public Function GetAttachmentFromFolder(ByVal FolderName, ByVal FileName, ByVal OutPath)
Dim TreeManager
Set TreeManager = TDConnection.TreeManager

Dim SubjectNode
Set SubjectNode = TreeManager.NodeByPath(FolderName)

GetAttachmentFromFolder = GetAttachmentFromTestObject(SubjectNode, FileName, OutPath)
End Function



'''
''' Gets all attachments from a QC folder by its extension.
'''

''' Node in QC Test Plan to get files from.
''' Wildcard filename with desired extension.
''' Local path to save the file.
Public Sub GetAttachmentsFromFolderByExt(ByVal FolderName, ByVal FileName, ByVal OutPath)
Const vbTextCompare = 1

'Ensure path ends with "\"
If Right(OutPath, 1) <> "\" Then
OutPath = OutPath & "\"
End If

'Check if wildchar search.
If Left(FileName, InStr(FileName, ".") - 1) = "*" Then
'Gets subnodes of the given root node.
Dim arrStrNodesList
arrStrNodesList = GetNodesList(FolderName)

'Get all file attachments with Ext for each of the given nodes in the node list.
Dim strNode
For Each strNode In arrStrNodesList
Dim TreeManager
Set TreeManager = TDConnection.TreeManager

Dim SubjectNode
Set SubjectNode = TreeManager.NodeByPath(strNode)

Dim AttachmentFactory, AttachmentList
Set AttachmentFactory = SubjectNode.Attachments
Set AttachmentList = AttachmentFactory.NewList("")

Dim Attachment, LongFileName, ExtendedStorage
For Each Attachment In AttachmentList
If StrComp(GetExt(Attachment.Name(1)), GetExt(FileName), vbTextCompare) = 0 Then 'Equal Extension
LongFileName = Attachment.Name

'Get filename from Server File Name (Filename is after node ID)
Dim NodeID, RealFileName
NodeID = SubjectNode.NodeID
RealFileName = Right(LongFileName, Len(LongFileName) - InStr(LongFileName, NodeID) - Len(NodeID))

Dim strLocalTestFolder
strLocalTestFolder = OutPath & SubjectNode.Path
WScript.Echo "Create local folder: " & strLocalTestFolder
CreateFolderPath(strLocalTestFolder) ' Create folder including parent folders.

Call GetAttachmentFromTestObject(SubjectNode, RealFileName, strLocalTestFolder)
WScript.Echo vbCrLf
End If
Next
Next
End If
End Sub



'''
''' Retrieves an attachment from a test object to a local file.
'''

''' The test object that contains the attachment
''' The File Name of the attachment.
''' The path to which to save the file.
''' Path including filename of the attachment on the local filesystem.
Public Function GetAttachmentFromTestObject(ByRef Object, ByVal FileName, ByVal OutPath)
Dim strRetVal
strRetVal = ""
Const vbTextCompare = 1

Dim AttachmentFactory, AttachmentList
Set AttachmentFactory = Object.Attachments
Set AttachmentList = AttachmentFactory.NewList("")

'Ensure path ends with "\"
If Right(OutPath, 1) <> "\" Then
OutPath = OutPath & "\"
End If

Dim Attachment, LongFileName, ExtendedStorage
For Each Attachment In AttachmentList
If StrComp(Attachment.Name(1), FileName, 1) = False Then ' Equal
LongFileName = Attachment.Name 'Actual ServerFileName of attachment in QC.
Set ExtendedStorage = Attachment.AttachmentStorage
ExtendedStorage.ClientPath = OutPath
ExtendedStorage.Load LongFileName, True

'Get filename from Server File Name (Filename is after node ID)
Dim NodeID, RealFileName
NodeID = Object.NodeID
RealFileName = Right(LongFileName, Len(LongFileName) - InStr(LongFileName, NodeID) - Len(NodeID))

'Rename file to what we expect the file to be named and not the ServerFileName.
If MoveFile(OutPath & LongFileName, OutPath & RealFileName, True) = True Then
strRetVal = OutPath & RealFileName
WScript.Echo "Successfully exported attachment """ & OutPath & RealFileName & """"
Exit For
Else
WScript.Echo "Failed to exported attachment """ & OutPath & RealFileName & """"
End If
End If
Next

GetAttachmentFromTestObject = strRetVal
End Function



'''
''' Returns the name of the extension of the passed filename.
'''

''' Filename to get extension from.
''' The extension of the given filename.
Public Function GetExt(FileName)
GetExt = Right(FileName, Len(FileName) - InStr(FileName, "."))
End Function

'End Region
Occasional Visitor
r.sch
Posts: 2
Registered: ‎01-04-2011
Message 5 of 13 (6,752 Views)

Re: BackUp QTP scripts stored in Quality Center

Hi Percy,

thank you very much for this script. If i try to run it, after entering my user name etc., i'll get an error in line 101. This is the
qtApp.Open str.QCTestPath, True
line in the SaveQTPTests function.
The error message is: "Cannot open test.", code: "800A03EE".

Happy new Year, yours

Roland
Trusted Contributor
Percy Bell
Posts: 348
Registered: ‎09-18-2008
Message 6 of 13 (6,752 Views)

Re: BackUp QTP scripts stored in Quality Center

What version of QC and QTP are you using?
I developed this script for QC 9.2 and QTP 9.2/9.5/10. I haven't tested it out on any other version. Also what is the path that was constucted?
Occasional Visitor
r.sch
Posts: 2
Registered: ‎01-04-2011
Message 7 of 13 (6,752 Views)

Re: BackUp QTP scripts stored in Quality Center

Update: it was a permission problem in qc not a script problem

Yours

Roland
Advisor
Lakshmanan
Posts: 17
Registered: ‎03-08-2009
Message 8 of 13 (6,472 Views)

Re: BackUp QTP scripts stored in Quality Center

Thank you. I just want to save a copy of QTP Test Script in the file system. I want to do it for many QTP Tests by providing Test Case Id as input. Could you please help me on this?

Advisor
Lakshmanan
Posts: 17
Registered: ‎03-08-2009
Message 9 of 13 (6,469 Views)

Re: BackUp QTP scripts stored in Quality Center

The current script retrieves the attachments from the Folders (Not from Test). How to retrieve / download the attachments from each Test. Please advise.

Occasional Visitor
knowwhatyouknow
Posts: 1
Registered: ‎08-24-2013
Message 10 of 13 (3,041 Views)

Re: BackUp QTP scripts stored in Quality Center

Hi Percy,

 

I badly need your help.

 

am trying to download huge number of QTP scripts(150 in one folder) from QC. But unable to download it.

 

The Script is not actually downloading the QTP test scripts from QC.

 

It neither throws any error nor downloads the QTP Scripts.

 

I observed that QTP running in the invisible mode But where as in C:\ It is not downloading any scripts.

 

PS: refer the attachment for code.

Frequent Visitor
michaeltewierik
Posts: 2
Registered: ‎08-22-2012
Message 11 of 13 (2,677 Views)

Re: BackUp QTP scripts stored in Quality Center

My version of the above solution. A big thank-you for the above solution as it had most of the features I wanted and was simple to update.


I had exactly the same need and the script is attached for your convenience. I developed this based on a sample or two I found on the internet (including the one supplied in the comments here), however through "my" version of coding practices it has changed quite a bit and adds a few things I feel are required to make it useful.

DISCLAIMER::
I will say that it has not been thoroughly QA'd as yet so there may be a few bugs, but if you address the few variables at the top of the script it should work as required.
Msgbox's have been added for my enjoyment during debugging. If you don't like them, remove them :)

FEATURES:
- According to a base QC/ALM folder supplied, backs up all QTP test scripts and ALL attachments as per all folders and sub-folders into a temp folder directly matching the structure.
- Zips the final result, then deletes the temp folder ;)
I envision using this via the Windows Scheduler once a day to give me a complete archive.

REQUIRES:
ALM/QC API installed,
QTP/UFT installed


(insert into a ".vbs" file, update the variables, save, close, double click :)

Option Explicit
Dim oALMConnection, sStoragePath

BackUpQTPFromALM

Function BackUpQTPFromALM()
    Dim sALM, sDomain, sProject, sUserName, sPassword, sSourcePath, aQTPTests, sFileName, sStartTime, sEndTime
		sStartTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2)
        'Quality Center Project settings
        sALM = "http://alm/qcbin/" '<-- Change me.
        sUserName = "myUsername" '<-- Change me.
        sPassword = "myPassword" '<-- Change me.
        sDomain = "myDomain" '<-- Change me.
        sProject = "myProject" '<-- Change me.
        sStoragePath = "c:\TEMP\~BACK-UP\Temp_" & GetReverseDate & sStartTime
        sSourcePath = "Subject\TestAutomation\" '<-- Change me.
        '// STEP 1: Get the ALM Object and connect to the project  ////////////////////////////////////////////////////////////////////////////////////////////////
        Set oALMConnection = CreateObject("TDApiOle80.TDConnection")
        oALMConnection.InitConnectionEx sALM
        oALMConnection.Login sUserName, sPassword
        If (oALMConnection.LoggedIn <> True) Then
            MsgBox "ALM User Authentication Failed"
            Exit Function 'WScript.Quit
        End If
        oALMConnection.Connect sDomain, sProject
        '// STEP 2: Get the QTP Tests to back-up  ////////////////////////////////////////////////////////////////////////////////////////////////
        aQTPTests = ALM_GetQTPTestsFromQC(oALMConnection, sSourcePath)
Msgbox "Got the test names"
        '// STEP 3: Save the QTP Tests to back-up  ////////////////////////////////////////////////////////////////////////////////////////////////
        Call ALM_SaveQTPTests(aQTPTests, Array(sALM, sDomain, sProject, sUserName, sPassword), sStoragePath)
Msgbox "Tests saved"
        '// STEP 4: Get the QTP Attachments to back-up  ////////////////////////////////////////////////////////////////////////////////////////////////
        Call ALM_GetAttachmentsFromFolder(sSourcePath, sFileName, sStoragePath)
Msgbox "Attachments complete"
        'Close Quality Center Connection
        oALMConnection.Disconnect
        oALMConnection.Logout
        oALMConnection.ReleaseConnection
        Set oALMConnection = Nothing
        'Zip The File
        sEndTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2)
        Zip sStoragePath & "TestAutomation_" & GetReverseDate & sStartTime & "-" & sEndTime & ".zip", sStoragePath
    MsgBox "Completed"
End Function


'######################################################################
'// STEP 1: Get the QTP Tests to back-up  ////////////////////////////////////////////////////////////////////////////////////////////////
'######################################################################
    Public Function ALM_GetQTPTestsFromQC(oALMConnection, sSourcePath)
        '=============================================
        'Gets the name and path of QTP tests for the give node in QC's Test Plan Module.
        '=============================================
        Dim i, sNode, oTestList, oTest, oTreeManager, oSubjectNode, oTestFactory, oTFilter
        Dim aQTPTests()
        'ReDim aNodesList(0)
        'aNodesList =
        i = 0
        'Get all QTP test for each of the given nodes in the node list.
        For Each sNode In ALM_GetNodesList(oALMConnection, sSourcePath)
            Set oTreeManager = oALMConnection.TreeManager
            Set oSubjectNode = oTreeManager.NodeByPath(sNode)
            Set oTestFactory = oSubjectNode.TestFactory
            Set oTFilter = oTestFactory.Filter
            oTFilter("TS_TYPE") = "= 'QUICKTEST_TEST'"
            Set oTestList = oTestFactory.NewList(oTFilter.Text)
            'Get the name and path for each of the QTP tests in the test list.
            For Each oTest In oTestList
                ReDim Preserve aQTPTests(i)
                'Create a QTPTestClass to make setting and getting the path and name easier.
                aQTPTests(i) = oSubjectNode.Path & "~" & oTest.Name
                i = i + 1
            Next
        Next
        'Cleanup objects
        Set oTest = Nothing
        Set oTestList = Nothing
        Set oTFilter = Nothing
        Set oTestFactory = Nothing
        Set oSubjectNode = Nothing
        Set oTreeManager = Nothing
        ALM_GetQTPTestsFromQC = aQTPTests
    End Function


'######################################################################
'// STEP 2: Save the QTP Tests to back-up  ////////////////////////////////////////////////////////////////////////////////////////////////
'######################################################################
    Sub ALM_SaveQTPTests(aQTPTests, aALMDetails, sStoragePath)
        '=============================================
        'Start QTP load test from array and save test locally in same folder structure as QC.
        '=============================================
        'Create QTP object to control QTP
        Dim oQTP, oQTPTest, sQCTestPath, sLocalTestPath, sLocalTestFolder, i, aVal
        Set oQTP = CreateObject("QuickTest.Application")
        'If connection not already established then establish connection(QTP already running)
        If Not oQTP.TDConnection.IsConnected Then oQTP.TDConnection.Connect aALMDetails(0), aALMDetails(1), aALMDetails(2), aALMDetails(3), aALMDetails(4), False
        oQTP.Launch ' Start QuickTest
        oQTP.Visible = False ' Make the QuickTest application invisible
        'Get each QTP test's name and path to load and save.
        For Each oQTPTest In aQTPTests
            aVal = Split(oQTPTest, "~")
            If oQTP.TDConnection.IsConnected Then ' If connection is successful
                oQTP.Open "[QualityCenter] " & aVal(0) & "\" & aVal(1), True ' Open test in read only mode
                FSO_CreateFolderPath sStoragePath & "\" & aVal(0) ' Create folder including parent folders.
                oQTP.Test.SaveAs sStoragePath & "\" & aVal(0) & "\" & aVal(1) ' Save test to local path.
            Else
                MsgBox "Cannot connect to Quality Center" ' If connection is not successful, display an error message.
            End If
        Next
        oQTP.Quit ' Exit QuickTest
        Set oQTP = Nothing
    End Sub
    
    
'######################################################################
'// STEP 3: Get the QTP Attachments to back-up  ////////////////////////////////////////////////////////////////////////////////////////////////
'######################################################################
    Public Sub ALM_GetAttachmentsFromFolder(ByVal sFolderName, ByVal sFileName, ByVal sOutPath)
        '=============================================
        'Gets all attachments from a QC folder
        '=============================================
        Dim aNodesList, sNode, oTreeManager, oSubjectNode, oAttachmentFactory, oAttachmentList, oAttachment, sLongFileName, ExtendedStorage, oNode, iNodeID, sRealFileName, sLocalTestFolder
        'Ensure path ends with "\"
        If Right(sOutPath, 1) <> "\" Then sOutPath = sOutPath & "\"
        'Gets subnodes of the given root node.
        aNodesList = ALM_GetNodesList(oALMConnection, sFolderName)
        'Get all file attachments with Ext for each of the given nodes in the node list.
        Set oTreeManager = oALMConnection.TreeManager
        For Each oNode In aNodesList
            Set oSubjectNode = oTreeManager.NodeByPath(oNode)
            Set oAttachmentFactory = oSubjectNode.Attachments
            Set oAttachmentList = oAttachmentFactory.NewList("")
            For Each oAttachment In oAttachmentList
                sLongFileName = oAttachment.Name
                'Get filename from Server File Name (Filename is after node ID)
                iNodeID = oSubjectNode.NodeID
                sRealFileName = Right(sLongFileName, Len(sLongFileName) - InStr(sLongFileName, iNodeID) - Len(iNodeID))
                sLocalTestFolder = sOutPath & oSubjectNode.Path
                FSO_CreateFolderPath (sLocalTestFolder) ' Create folder including parent folders.
                Call ALM_GetAttachmentsFromTestObject(oSubjectNode, sRealFileName, sLocalTestFolder)
            Next
	Exit Sub
        Next
    End Sub
    

'######################################################################
    Public Function ALM_GetAttachmentsFromTestObject(ByRef oTestObject, ByVal sFileName, ByVal sOutPath)
        '=============================================
        'Retrieves an attachment from a test object to a local file.
        '=============================================
        Dim sRetVal, oAttachmentFactory, oAttachmentList, oAttachment, sLongFileName, oExtendedStorage, iNodeID, sRealFileName
        sRetVal = ""
        Set oAttachmentFactory = oTestObject.Attachments
        Set oAttachmentList = oAttachmentFactory.NewList("")
        'Ensure path ends with "\"
        If Right(sOutPath, 1) <> "\" Then sOutPath = sOutPath & "\"
        For Each oAttachment In oAttachmentList
            If StrComp(oAttachment.Name(1), sFileName, 1) = False Then ' Equal
                sLongFileName = oAttachment.Name 'Actual ServerFileName of attachment in QC.
                Set oExtendedStorage = oAttachment.AttachmentStorage
                oExtendedStorage.ClientPath = sOutPath
                oExtendedStorage.Load sLongFileName, True
                'Get filename from Server File Name (Filename is after node ID)
                iNodeID = oTestObject.NodeID
                sRealFileName = Right(sLongFileName, Len(sLongFileName) - InStr(sLongFileName, iNodeID) - Len(iNodeID))
                'Rename file to what we expect the file to be named and not the ServerFileName.
                If FSO_MoveFile(sOutPath & sLongFileName, sOutPath & sRealFileName, True) = True Then
                    sRetVal = sOutPath & sRealFileName
                    Exit For
                End If
            End If
        Next
        ALM_GetAttachmentsFromTestObject = sRetVal
    End Function
    

'//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'// SUB FUNCTIONS  ////////////////////////////////////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////////////////////////////////////////////////////

'######################################################################
    Public Function ALM_GetNodesList(oALMConnection, sSourcePath)
        '=============================================
        'Returns an array for all children of a given Node of a tree.
        '=============================================
        'Specify Array to contain all nodes of subject tree.
        Dim aNodesList()
        ReDim Preserve aNodesList(0)
        aNodesList(0) = sSourcePath
        Dim oTreeManager, oSubjectNode
        Set oTreeManager = oALMConnection.TreeManager
        Set oSubjectNode = oTreeManager.NodeByPath(sSourcePath)
        'Run on all children nodes
        Dim i, iNewUpper
        For i = 1 To oSubjectNode.Count
            'If current node has a child then get path on child nodes too.
            If oSubjectNode.Child(i).Count >= 1 Then
                Dim aTempNodeList
                aTempNodeList = ALM_GetNodesList(oALMConnection, oSubjectNode.Child(i).Path)
                
                Dim sNode
                For Each sNode In aTempNodeList
                    'Add more space to dynamic array
                    iNewUpper = UBound(aNodesList) + 1
                    ReDim Preserve aNodesList(iNewUpper)
                    'Add strNode path to array
                    aNodesList(iNewUpper) = sNode
                Next
            Else
                'Add more space to dynamic array
                iNewUpper = UBound(aNodesList) + 1
                ReDim Preserve aNodesList(iNewUpper)
                
                'Add strNode path to array
                aNodesList(iNewUpper) = oSubjectNode.Child(i).Path
            End If
        Next
        ' Cleanup objects
        Set oSubjectNode = Nothing
        Set oTreeManager = Nothing
        ALM_GetNodesList = aNodesList
    End Function
    

'######################################################################
    Function FSO_CreateFolderPath(sFolderPath)
        '=============================================
        'Creates a file system folder including parent folders
        '=============================================
        Dim oFSO, sChildFolder, sParentDir
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        If Not oFSO.FolderExists(sFolderPath) Then
            sChildFolder = Right(sFolderPath, Len(sFolderPath) - InStrRev(sFolderPath, "\"))
            sParentDir = Left(sFolderPath, Len(sFolderPath) - Len(sChildFolder) - 1)
            If Not (oFSO.FolderExists(sParentDir)) Then FSO_CreateFolderPath (sParentDir)
            If Not (oFSO.FolderExists(sFolderPath)) Then oFSO.CreateFolder (sFolderPath)
        End If
    End Function
    

'######################################################################
    Public Function FSO_MoveFile(ByVal sSourceFile, ByVal sDestinationFile, ByVal bOverwrite)
    '=============================================
    'Moves the designated file.
    '=============================================
        Dim bRetVal, oFSO
        bRetVal = False
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        'If overwrite flag set then delete already existing file so rename will succeed.
        If (oFSO.FileExists(sDestinationFile) = True) And (bOverwrite = True) Then oFSO.DeleteFile (sDestinationFile)
        On Error Resume Next
            oFSO.MoveFile sSourceFile, sDestinationFile
            If Err.Number <> 0 Then
                bRetVal = False
            Else
                bRetVal = True
            End If
            Err.Clear
        On Error GoTo 0
        Set oFSO = Nothing
        FSO_MoveFile = bRetVal
    End Function
	

'######################################################################
Public Sub ALM_BuildTestPlan(strParentKey, strNodePath)
    Dim intUniqueKeyNo
    Dim strThisKey
    Dim oSubjectNode
    Dim ChildSubjectNodes
    Dim oChildNode
    Dim strExpectedPath
    Dim TestFact
    Dim TestFilter
    Dim TestList
    Dim oTest
    Dim strTestKey
    
    'Get the Subject Node
    Set oSubjectNode = TestPlanGetSubjectNode(strNodePath)
    If (oSubjectNode Is Nothing) Then Exit Sub
    
    'Setup the key - Folders always have a key prefix of "f"
    intUniqueKeyNo = GetNextKey
    strThisKey = "f-" & intUniqueKeyNo
    
    'Add this Folder into the datastructure
    Call AddQCTestPlanItem(strThisKey, strParentKey, oSubjectNode.Name, strNodePath)
    
    'Does it have any child folders?
    Set ChildSubjectNodes = oSubjectNode.FindChildren("", False, "")
    If Not (ChildSubjectNodes Is Nothing) Then
        'This gives us a list of all children + subchildren so we need to filter it a bit
        For Each oChildNode In ChildSubjectNodes
            strExpectedPath = strNodePath & "\" & oChildNode.Name
            If strExpectedPath = oChildNode.Path Then
                'It's a direct child so iterate it
                Call BuildTestPlan(strThisKey, strExpectedPath)
            End If
        Next
    End If
    
    'Now it's processed all the child folders, look to see if there are any tests
    Set TestFact = tdc.TestFactory
    Set TestFilter = TestFact.Filter
    TestFilter.Filter("TS_SUBJECT") = Chr(34) & strNodePath & Chr(34)
    Set TestList = TestFact.NewList(TestFilter.Text)
    
    'Scan through all of the tests
    For Each oTest In TestList
        If (oTest.Type = "QUICKTEST_TEST") Then
            'mark it as a QTP test ("q" prefix)
            strTestKey = "q-" & GetNextKey
            Call AddQCTestPlanItem(strTestKey, strThisKey, oTest.Name, strNodePath)
        Else
            'mark it as a normal test ("t" prefix)
            strTestKey = "t-" & GetNextKey
            Call AddQCTestPlanItem(strTestKey, strThisKey, oTest.Name, strNodePath)
        End If
    Next
    
End Sub

Function GetReverseDate()
    GetReverseDate = Year(Now) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2) & "_"
End Function



'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@    @@  @@   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@  @@@  @@ @@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@  @@@@  @@  @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@    @@  @@  @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Public Sub Zip(ZipFile, InputFile)
    Dim FSO 'Scripting.FileSystemObject
    Dim oApp 'Shell32.Shell
    Dim oFld 'Shell32.Folder
    Dim oShl 'WScript.Shell
    Dim i
    Dim l
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FileExists(ZipFile) Then FSO.CreateTextFile(ZipFile, True).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
    Set oApp = CreateObject("Shell.Application")
    Set oFld = oApp.Namespace(ZipFile)
    i = oFld.Items.Count
    oFld.CopyHere (InputFile)
    Set oShl = CreateObject("WScript.Shell")
    'Search for a Compressing dialog
    Do While oShl.AppActivate("Compressing...") = False
        If oFld.Items.Count > i Then
            'There's a file in the zip file now, but
            'compressing may not be done just yet
            Exit Do
        End If
        If l > 30 Then
            '3 seconds has elapsed and no Compressing dialog
            'The zip may have completed too quickly so exiting
            Exit Do
        End If
        DoEvents
        fnWait 1
        l = l + 1
    Loop
    ' Wait for compression to complete before exiting
    Do While oShl.AppActivate("Compressing...") = True
        DoEvents
        fnWait 1
    Loop
    If FSO.FolderExists(InputFile) Then FSO.DeleteFolder InputFile, True
    Set FSO = Nothing
    Set oFld = Nothing
    Set oApp = Nothing
    Set oShl = Nothing
End Sub

Function fnWait(intNrOfSeconds)
    Dim varStart
      varStart = Timer
      Do While Timer < varStart + intNrOfSeconds
      Loop
End Function

 

VKR
Member
VKR
Posts: 4
Registered: ‎02-21-2014
Message 12 of 13 (778 Views)

Re: BackUp QTP scripts stored in Quality Center

These backup's are taken to use it during accidental deletion, so how do we import the scripts back to ALM ?

 

Frequent Advisor
Nilesh Desai
Posts: 41
Registered: ‎03-20-2008
Message 13 of 13 (111 Views)

Re: BackUp QTP scripts stored in Quality Center

Hi

 

I am getting VB Error = "ActiveX component can't create object 'TDApiOle80.TDConnection' "

 

For the following line in the .vbs

-       Set oALMConnection = CreateObject("TDApiOle80.TDConnection")


I am using ALM 11.52 w/QTP 11 combination.

 

 

The opinions expressed above are the personal opinions of the authors, not of HP. By using this site, you accept the Terms of Use and Rules of Participation.