Download and Upload QTP scripts from Quality Center (QC)

are you tired with QC for storing and downloading QTP scripts?

QC slowness is very common issue and HP should take this on priority.  But till that time lets see how to overcome this QC slowness issue. One way to write an Excel Macro which will take care of uploading and downloading of QTP scripts. Please see how:

1. this is Excel where you need to provide appropriate details:

 2. When you click on download scripts button the macro will download all qtp test scripts from given node to given shared folder path. the same way when you click on Upload scripts the macro will  upload all scripts from shared folder path to QC.


------------------------------------------------------------------------------------------------------------------------------

See what happen when user click on download scripts or upload scripts buttons


Sub cmdDownloadScripts_Click()

'Confirm Download
Dim Response As VbMsgBoxResult
Response = Msgbox("Confirmation: Download Scripts from QC?", vbQuestion + vbYesNo)
If Response = vbNo Then
    Msgbox "Download Canceled."
    Exit Sub
End If

'Confirm Attachment Download
Dim ResponseA As VbMsgBoxResult
ResponseA = Msgbox("Confirmation: Download Scripts with Attachments?", vbQuestion + vbYesNo)
If ResponseA = vbYes Then
    iReplyA = "Yes"
Else
    iReplyA = "No"
    Msgbox "Download Attachments Cancelled."
    'Exit Sub
End If

'Clear Results and Values
    RowCount = ThisWorkbook.Worksheets("Scripts").UsedRange.Rows.Count
    If RowCount > 13 Then
    ThisWorkbook.Worksheets("Scripts").Range("A14", "A" & RowCount).Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.EntireRow.Delete
    ThisWorkbook.Save
    End If

strQualityCenterURL = Trim(Sheets("Scripts").Range("B2").Value)
strDomain = Trim(Sheets("Scripts").Range("B5").Value)
strProject = Trim(Sheets("Scripts").Range("B6").Value)
strUserName = Trim(Sheets("Scripts").Range("B3").Value)
strPassword = Trim(Sheets("Scripts").Range("B4").Value)
strTestPlanProjectPath = Trim(Sheets("Scripts").Range("B8").Value)
strSharedFolderPath = Trim(Sheets("Scripts").Range("B9").Value)

Dim qtApp 'As QuickTest.Application ' Declare the Application object variable
Dim tdc
Dim ModuleName

Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object
qtApp.Launch ' Start QuickTest
qtApp.Visible = True ' Make the QuickTest application visible

' Connect to the Quality Center
If Not qtApp.TDConnection.IsConnected Then
    qtApp.TDConnection.Connect strQualityCenterURL, strDomain, strProject, strUserName, strPassword, False
End If

If qtApp.TDConnection.IsConnected Then ' If connection is successful

    Set tdc = qtApp.TDConnection.TDOTA
    Set TreeMgr = tdc.TreeManager
   
    ' Use TreeManager.RootList to get the Subject root.
    Set Trees = TreeMgr.RootList(TDOLE_SUBJECT)
    Set MyTrees = TreeMgr.NodeByPath(strTestPlanProjectPath)
   
    If MyTrees.Count = 0 Then
        ModuleName = ""
        testPath = MyTrees.Path
        strFSPath = strSharedFolderPath
        Call CreateFolder(strFSPath)
        If iReplyA = "Yes" Then
            strFSAPath = strFSPath & "\" & Trim(ModuleName) & " Attachments\"
            Call CreateFolder(strFSAPath)
        End If
        Call DownloadScripts(qtApp, tdc, testPath, strFSPath, ModuleName)
        If iReplyA = "Yes" Then
            Call DownloadAttachements(qtApp, tdc, testPath, strFSAPath)
        End If
    End If

   Call CreateFolder(strSharedFolderPath)
  
   For iChild = 1 To MyTrees.Count
        ModuleName = Trim(MyTrees.Child(iChild).Name)
        strFSPath = strSharedFolderPath & "\" & ModuleName
        Call CreateFolder(strFSPath)
        If iReplyA = "Yes" Then
             strFSAPath = strFSPath & "\" & ModuleName & " Attachments\"
            Call CreateFolder(strFSAPath)
        End If
        Set Locate = MyTrees.FindChildNode(ModuleName)
        testPath = Locate.Path
        Call DownloadScripts(qtApp, tdc, testPath, strFSPath, ModuleName)
        If iReplyA = "Yes" Then
            Call DownloadAttachements(qtApp, tdc, testPath, strFSAPath)
        End If
    Next
   
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

' Exit QuickTest
qtApp.Quit

' Release the Application object
Set qtApp = Nothing
Set Locate = Nothing
Set MyTrees = Nothing
Set Trees = Nothing
Set TreeMgr = Nothing
Set tdc = Nothing

Msgbox "Download Process is completed"

End Sub
Function WriteScriptNames(strFSPath, strScriptName, ModuleName, resFlag)

    iRow = Sheets("Scripts").UsedRange.Rows.Count + 1
    Sheets("Scripts").Range("A" & iRow).Value = strFSPath
    Sheets("Scripts").Range("B" & iRow).Value = strScriptName
    Sheets("Scripts").Range("D" & iRow).Value = ModuleName
    Sheets("Scripts").Range("E" & iRow).Value = resFlag
   
End Function
Function CreateFolder(strFolderPath)

   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")

   If Not (fso.FolderExists(strFolderPath)) Then
        Set f = fso.CreateFolder(strFolderPath)
        Set f = Nothing
   End If

   Set fso = Nothing
  
End Function

Function DownloadScripts(qtApp, tdc, testPath, strFSPath, ModuleName)

    For Each oTestSet In tdc.TreeManager.NodeByPath(testPath).TestFactory.NewList("")
           
            ScriptName = oTestSet.Name
            Script = "[QualityCenter] " & testPath & "\" & ScriptName
            ScriptFSScript = strFSPath & "\" & ScriptName
           
            resFlag = ""
            Flag = False
            On Error Resume Next
            qtApp.Open Script, False ' Open the test
            If Err.Number <> 0 Then
            Flag = True
            End If
            qtApp.Test.SaveAs ScriptFSScript
            If Err.Number <> 0 Then
            Flag = True
            Else
            qtApp.Test.Close
            End If
           
            If Flag = True Then
                resFlag = "Error: " & Err.Description
                Flag = False
                Err.Clear
            Else
                resFlag = "Pass"
            End If
            Call WriteScriptNames(strFSPath, ScriptName, ModuleName, resFlag)
           
            resFlag = ""
Next
End Function
Function DownloadAttachements(qtApp, tdc, testPath, strFSAPath)

    For Each oTestSet In tdc.TreeManager.NodeByPath(testPath).TestFactory.NewList("")
            ScriptName = oTestSet.Name
            Script = "[QualityCenter] " & testPath & "\" & ScriptName
            Dim otaAttachmentFactory
            Dim otaAttachment 'As TDAPIOLELib.Attachment
            Dim otaAttachmentList 'As List,
            Dim TAttach 'As Attachment 'As TDAPIOLELib.List
            Dim otaTreeManager 'As TDAPIOLELib.TreeManager
            Dim otaSysTreeNode 'As TDAPIOLELib.SysTreeNode
            Dim otaExtendedStorage, AttachDow
            Dim fso
           
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set otaAttachmentFactory = oTestSet.Attachments
            Set otaAttachmentList = otaAttachmentFactory.NewList("")
            'MsgBox "Attachment Count:" & otaAttachmentList.Count
           
            If otaAttachmentList.Count > 0 Then
            Set otaAttachment = otaAttachmentList.Item(1)
            otaAttachment.Load True, ""
            strPath = otaAttachment.Filename
           
                     DownloadAttachements = strPath
                     SysPathF = strFSAPath & "Attachments_" & oTestSet.Name
                     Call CreateFolder(SysPathF)
                     SysPath = SysPathF & "\"
                     Call CreateFolder(SysPath)
                     fso.CopyFile strPath, SysPath
            Else
            'MsgBox "Fail"
            DowloadAttachment = "Empty"
            End If
         
            Set otaAttachmentFactory = Nothing
            Set otaAttachment = Nothing
            Set otaAttachmentList = Nothing
            Set otaTreeManager = Nothing
            Set otaSysTreeNode = Nothing
            Set fso = Nothing

        Next

End Function
Sub cmdUploadScripts_Click()

'Confirm Upload
Dim Response As VbMsgBoxResult
Response = Msgbox("Confirmation: Upload Scripts to QC?", vbQuestion + vbYesNo)
If Response = vbNo Then
    Msgbox "Upload to QC Canceled."
    Exit Sub
End If

'Confirm Attachemnt Upload
Dim ResponseA As VbMsgBoxResult
ResponseA = Msgbox("Confirmation: Upload Scripts with Attachments?", vbQuestion + vbYesNo)
If ResponseA = vbYes Then
    iReplyA = "Yes"
Else
    iReplyA = "No"
    Msgbox "Upload Attachments Cancelled."
    'Exit Sub
End If

Call GenQCUploadPath
strQualityCenterURL = Trim(Sheets("Scripts").Range("C2").Value)
strDomain = Trim(Sheets("Scripts").Range("C5").Value)
strProject = Trim(Sheets("Scripts").Range("C6").Value)
strUserName = Trim(Sheets("Scripts").Range("C3").Value)
strPassword = Trim(Sheets("Scripts").Range("C4").Value)
strTestPlanProjectPath = Trim(Sheets("Scripts").Range("C8").Value)
RowCount = ThisWorkbook.Worksheets("Scripts").UsedRange.Rows.Count
If RowCount > 13 Then
ThisWorkbook.Worksheets("Scripts").Range("F14", "F" & RowCount).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Delete Shift:=xlUp
ThisWorkbook.Save
End If

'Get the Paths from Worksheet
strQualityCenterURL = Trim(Sheets("Scripts").Range("C2").Value)
strDomain = Trim(Sheets("Scripts").Range("C5").Value)
strProject = Trim(Sheets("Scripts").Range("C6").Value)
strUserName = Trim(Sheets("Scripts").Range("C3").Value)
strPassword = Trim(Sheets("Scripts").Range("C4").Value)
strTestPlanProjectPath = Trim(Sheets("Scripts").Range("C8").Value)
strSharedFolderPath = Trim(Sheets("Scripts").Range("C9").Value)

Dim qtApp 'As QuickTest.Application ' Declare the Application object variable
Dim tdc
Dim ModuleName

Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object
Set tdc = qtApp.TDConnection.TDOTA
qtApp.Launch ' Start QuickTest
qtApp.Visible = True ' Make the QuickTest application visible

' Connect to the Quality Center
If Not qtApp.TDConnection.IsConnected Then
    qtApp.TDConnection.Connect strQualityCenterURL, strDomain, strProject, strUserName, strPassword, False
End If

If qtApp.TDConnection.IsConnected Then ' If connection is successful
       
        iMaxRow = Sheets("Scripts").UsedRange.Rows.Count
        Set tdc = qtApp.TDConnection.TDOTA
        For iRow = 14 To iMaxRow
            strQCPath = Trim(Sheets("Scripts").Range("C" & iRow).Value)
            strScriptName = Trim(Sheets("Scripts").Range("B" & iRow).Value)
            strFSFolder = Trim(Sheets("Scripts").Range("A" & iRow).Value)
           
            Call UploadScripts(qtApp, strScriptName, strQCPath, strFSFolder, iRow)
            If iReplyA = "Yes" Then
                strFSAPath = Trim(Sheets("Scripts").Range("A" & iRow).Value) & "\" & Trim(Sheets("Scripts").Range("D" & iRow).Value) & " Attachments\"
                Call UploadAttachments(tdc, strScriptName, strQCPath, strFSAPath)
            End If
           
        Next
       
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
Set Locate = Nothing
Set MyTrees = Nothing
Set Trees = Nothing
Set TreeMgr = Nothing
Set tdc = Nothing

Msgbox "Process is completed"
End Sub

Function UploadScripts(qtApp, ScriptName, strQCPath, strFSPath, iRow)
           
            QCScript = "[QualityCenter] " & strQCPath & "\" & ScriptName
            ScriptFSScript = strFSPath & "\" & ScriptName
            Flag = False

            On Error Resume Next
            qtApp.Open ScriptFSScript, False    ' Open the test
           
            If Err.Number <> 0 Then
                Flag = True
            Else
                qtApp.Test.SaveAs QCScript      ' Save it to Quality
            End If
           
            If Err.Number <> 0 Then
                Flag = True
            Else
                qtApp.Test.Close                ' Disconnect from Quality Cente
            End If
           
            If Flag = True Then
                Sheets("Scripts").Range("F" & iRow).Value = "Error: " & Err.Description
                Flag = False
                Err.Clear
            Else
                Sheets("Scripts").Range("F" & iRow).Value = "Pass"
            End If
           
End Function
'Sub Call1()
 'Call GenQCUploadPath
'End Sub
Function GenQCUploadPath()

iMaxRow = Sheets("Scripts").UsedRange.Rows.Count
For nrow = 14 To iMaxRow
If Trim(Sheets("Scripts").Range("D" & nrow).Value) <> "" Then
    Sheets("Scripts").Range("C" & nrow).Value = Sheets("Scripts").Range("C8").Value & "\" & Sheets("Scripts").Range("D" & nrow).Value
Else
    Sheets("Scripts").Range("C" & nrow).Value = Sheets("Scripts").Range("C8").Value
End If
Next

End Function

Function UploadAttachments(tdc, ScriptName, testPath, strFSAPath)
 
  Flag = 0
  On Error Resume Next
  For Each oTestSet In tdc.TreeManager.NodeByPath(testPath).TestFactory.NewList("")
       
       ScriptName = oTestSet.Name
       If ScriptName = oTestSet.Name And Flag = 0 Then
       
       Flag = 1
       
       Script = "[QualityCenter] " & testPath & "\" & ScriptName
       strFSAPath = strFSAPath & "Attachments_" & ScriptName
       
       Dim otaAttachmentFactory
       Dim otaAttachment
       Dim otaAttachmentList
       Dim fso, oFolder, oFile, ExStrg
       
       Set fso = CreateObject("Scripting.FileSystemObject")
       Set oFolder = fso.GetFolder(strFSAPath)
      
       If Err.Description = "Path not found" Then
            'Msgbox "Test Not found on filesystem. Note the Error. Err.Description:" & Err.Description
            nrow = Worksheets("Sheet2").UsedRange.Rows.Count
            Sheet2.Cells(nrow + 1, 1) = Err.Description & " for " & ScriptName
       End If
      
       'Pending: Check If the folder Exists; If not exit the loop iteration
       Set oFile = fso.GetFolder(strFSAPath).Files
      
       On Error Resume Next
       For Each oFile In oFolder.Files
            Filename = oFile.Name
            Set otaAttachmentFactory = oTestSet.Attachments
            Set otaAttachment = otaAttachmentFactory.AddItem(Filename)
            Filename = strFSAPath & Filename
            otaAttachment.Filename = Filename
            otaAttachment.Post
            Set ExStrg = otaAttachment.AttachmentStorage
            ExStrg.ClientPath = Script
            ExStrg.Save Filename, True
       Next
                    
       'Clear
       Set otaAttachmentFactory = Nothing
       Set otaAttachment = Nothing
       Set otaAttachmentList = Nothing
       Set fso = Nothing
       Set ExStrg = Nothing
       
       End If
    Next

End Function

Extract Defects in Excel from QC

Sharing the function to extract defects in Excel from QC. Need to change the following things specific to your project in the excel sheet

QC - URL
QC - Username and password
QC - Domain and project for which you need defects

You can filter defcts by proding search criteria

To this Excel macro click on ExtractDefects button.
----------------------------------------------------------------------------------------------------------------------------
Sub DefectsExtract()

Dim qcServer As String
qcServer = "http://qc.prod.internal.****.co.uk:8080/qcbin"
 
Dim QCConnection
Set QCConnection = CreateObject("TDApiOle80.TDConnection")


  QCConnection.InitConnectionEx qcServer
  QCConnection.Login "username", "password"
  QCConnection.Connect "Domain", "Project"
 
 
Dim Bug, Row
Dim i As Integer
Dim k As Integer

' Get a list of all the defects.

Dim BugFactory, BugList, bugfilter
Set BugFactory = QCConnection.BugFactory
Set bugfilter = BugFactory.Filter


bugfilter.Filter("BG_USER_03") = "Web" ' Filter the defects based on the stream value
bugfilter.Filter("BG_DETECTION_DATE") = ">01/03/2010"
Set bglist = bugfilter.NewList     
        ActiveSheet.Range("A1:O3000").ClearContents
        Row = 1
        Sheet2.Cells(Row, 1) = "Total No. of Defect with Status : " & bglist.Count
        Row = 2
        ' Heading for the Columns
        Sheet2.Cells(Row, 1).Value = "Defect_ID"
        Sheet2.Cells(Row, 2).Value = "Defect Summary"
        Sheet2.Cells(Row, 3).Value = "DetectedBy"
        Sheet2.Cells(Row, 4).Value = "Priority"
        Sheet2.Cells(Row, 5).Value = "Status"
        Sheet2.Cells(Row, 6).Value = "AssignedTo"
        Sheet2.Cells(Row, 7).Value = "Stream"

     For Each Bug In bglist      ' Save a specified set of fields.
               
                'For j = 0 To bglist.Count
                Row = Row + 1
                Sheet2.Cells(Row, 1).Value = Bug.Field("BG_BUG_ID")
                Sheet2.Cells(Row, 2).Value = Bug.Summary
                Sheet2.Cells(Row, 3).Value = Bug.DetectedBy
                Sheet2.Cells(Row, 4).Value = Bug.Priority
                Sheet2.Cells(Row, 5).Value = Bug.Status
                Sheet2.Cells(Row, 6).Value = Bug.AssignedTo
                Sheet2.Cells(Row, 7).Value = Bug.Field("BG_USER_03")
                'Next j
            Next

End Sub

Selenium - click on override link IE

How to get rid of SSL security certificatee page in IE

Simply use the following line before entering login information.

driver.navigate().to("javascript:document.getElementById('overridelink').click();

Here we are using java script to click on overridelink.

Use QC OTA to update Scripts

Thought of sharing a script which may be useful for you.
At some point of time you may have faced situation when all automation scripts are uploaded to QC or in File system , but then little change in approach like to associate one new Object Repository  or  need to have association of new library file or need to have association of Recovery scenarios to every script.

There are two way to update script
1. Open script one by one and perform manually associations
2. Use QC OTA to make this happen with script

The task can be easy if scripts are less in number but lets imagine user has more than 100 scripts. Its also cumbersome even if script are more than 50. So instead of doing association manually user can use OTA which we open script one by one and perform the required task.

Please find the following code to associate new OR to every single script in given QC node.

How to create Object Repository in absence of application:

Projects are going towards agile day by day and automation is becoming challenging. It is always good to start automation parallel with development. The problem is how to create script in absence of application. Well, its not impossible to create a script without application. All we need is user stories/screen sketch of GUI application. Yes I know you have question on object properties but hold your breath i am coming to that point latter. 

We had requirement in past to start with automation parallel with development process. The team was ready with framework and other prerequisite activities for automation but we still had to wait to see first version of GUI application. all we had was user stories diagrams. We decided to use our free time for script creation in absence of application. there are number of ways to create objects with dummy properties:

1. Using Excel sheet
2. Using XML Lets see one by one :

1. Using Excel sheet

Basic understanding of framework is required in order to understand this approach. Lets see the example of log in functionalities. We know that log in page has 2 web edit buttons for entering user name and password and 1 web button for log in. The things which we don't know is properties of this objects.

As we normally create script in keyword driven framework user follow the same approach. In properties column user can provide dummy properties as we don't know yet the actual properties.

Once application is available then user can change the dummy properties to actual ones. That's the only change required and script will run perfectly.


2. Using XML

This approach can be used in any framework.


XML file can be created for store dummy objects. user can add object name and its properties in text editor and then save it as XML. once the application is available then user can change the dummy properties to actual ones.