Saturday, December 24, 2011

QTPTrigger.vbs.txt

    'On Error Resume Next

    XMLVariables = Wscript.Arguments.item(0)

    'Variables which will be sent through XML
    Dim ScriptStoredAt
    Dim QCURL
    Dim loginID
    Dim loginPass
    Dim QCDomain
    Dim QCProject
    Dim TestSetFolderPath
    Dim TestSetName
    Dim EmailIDs
    Dim AdditionalComments
    Dim TestCaseNames


    Set oXMLDoc = CreateObject("MSXML2.DOMDocument")
    oXMLDoc.LoadXML XMLVariables
    Set oChilds = oXMLDoc.DocumentElement.ChildNodes
    For Each oChild In oChilds
        Execute oChild.nodeName & " = """ & oChild.nodeTypedValue & """"
    Next
    If LCase(ScriptStoredAt) = "qc" Then    ' This means that test scripts are stored in QC server

        'Identify if it is running for Test Case or complete Test Set. If Test Case Names is not provided then it will execute for complete Test Set
        If Len(Trim(TestCaseNames)) > 0 Then
            ItsForTestSet = False
        Else
            ItsForTestSet = True
        End If

        'Connecting to QC
        Set TDC = CreateObject("TDApiOle80.TDConnection")
        TDC.InitConnectionEx QCURL
        TDC.Login loginID, loginPass
        TDC.Connect QCDomain, QCProject

        'Navigating to Test Set
        Set tsFolder = TDC.TestSetTreeManager.NodeByPath(TestSetFolderPath)
        Set tsList = tsFolder.FindTestSets(TestSetName)

        'In case multiple Test Set exists of Same name under differnt sub folder then filter out by matching Test Set Folder absolute path
        If tsList.Count > 1 Then
            For Each Testsets In tsList
                If Testsets.TestSetfolder.Path & "\" = TestSetFolderPath Then
                    Set theTestSet = Testsets
                    Exit For
                End If
            Next
        Else
            Set theTestSet = tsList.Item(1)
        End If


        'if not executing complete test Set
        If Not (ItsForTestSet) Then
            'Get Testinstacne ID for all Test scripts
            Set TestInstanceList = theTestSet.TSTestFactory.NewList("")
       
            arrTestCasesNames = Split(TestCaseNames, ",")
            TestInstance = ""
       
            For i = 0 To UBound(arrTestCasesNames)
                For Each TestInstance In TestInstanceList
                    If LCase(TestInstance.Name) = LCase(arrTestCasesNames(i)) Then
                        TestInstanceIds = TestInstanceIds & TestInstance.ID & ","
                        Exit For
                    End If
                Next    'Testinstance
            Next    'TestCase Name

       
            If Len(TestInstanceIds) > 0 Then
                'Remove last comma
                TestInstanceIds = Left(TestInstanceIds, Len(TestInstanceIds) - 1)
            Else
                'If none of the test instance is provided then exit program
                Wscript.Quit
            End If

        End If
   
        'Email Execution start alert
        If Len(EmailIDs) > 0 Then
            Set oNet = CreateObject("Wscript.Network")
            LocalPCName = oNet.ComputerName
            Set oNet = Nothing
            If ItsForTestSet = True Then
                varMailBody = "<h1>Test Execution Started</h1><br><br><br>Execution Started for Complete TestSet :<br><br>"
                varMailBody = varMailBody & TestSetFolderPath & "\" & TestSetName
                varMailBody = varMailBody & "<br><br> Started at: " & LocalPCName & "<br><br>" & AdditionalComments
            Else
                varMailBody = "<h1>Test Execution Started</h1><br><br><br>Execution Started for Below TestCases :<br><br>"
                varMailBody = varMailBody & TestSetFolderPath & "\" & TestSetName & "<br> Test Case(s) : " & TestCaseNames
                varMailBody = varMailBody & "<br> Started at: " & LocalPCName & "<br><br>" & AdditionalComments
            End If
            TDC.SendMail EmailIDs, , "Test Execution -> Started @ " & LocalPCName, varMailBody
        End If

        'Starting Test Shecdular
        Set oScheduler = theTestSet.StartExecution("")
        oScheduler.RunAllLocally = True
   
        If ItsForTestSet Then
            oScheduler.Run
        Else
            oScheduler.Run (TestInstanceIds)
        End If

        Set execStatus = oScheduler.ExecutionStatus
        RunFinished = False
        startdatetime = Now
   
        'Sync till script execution completes. Cut off of 12 hours is implemented just to avoid infinte loop
        While ((RunFinished = False) And (CInt(ExecuteHours) <= 12))
       
            execStatus.RefreshExecStatusInfo "all", True
            RunFinished = execStatus.Finished
            'wscript.sleep (10000)     'Wait for 10 seconds
            ExecuteHours = DateDiff("h", CDate(startdatetime), Now)
            TDC.Connect QCDomain, QCProject  'Reconnecting to keep session alive
        Wend

        'Email Execution report
        If Len(EmailIDs) > 0 Then
            Report = ""
            TDC.Connect QCDomain, QCProject
            execStatus.RefreshExecStatusInfo "all", True
            For i = 1 To execStatus.Count
                Set TestExecStatusObj = execStatus.Item(i)
                TestIName = TDC.TSTestFactory.Item(TestExecStatusObj.TSTestID).Name
                If InStr(1, TestExecStatusObj.Message, "Fail",1) > 0 Then
                    Report = Report & "<font color = ""red""><br>Name: " & TestIName & " | Message: " & TestExecStatusObj.Message & " | status: " & TestExecStatusObj.Status & "</font>"
                ElseIf InStr(1, TestExecStatusObj.Message, "Pass",1) > 0 Then
                    Report = Report & "<font color = ""Green""><br>Name: " & TestIName & " | Message: " & TestExecStatusObj.Message & " | status: " & TestExecStatusObj.Status & "</font>"
                Else
                    Report = Report & "<font color = ""red""><br>Name: " & TestIName & " | Message: " & TestExecStatusObj.Message & " | status: " & TestExecStatusObj.Status & "</font>"
                End If
            Next
            Report = "<h1>Test Execution Summary</h1><br><br>Please see the results Below:<br><br><br><br>" & Report & "<br><br>======= End Of Report ======="
            TDC.SendMail EmailIDs, , "Test Execution -> Completed @ " & LocalPCName, Report
        End If


        TDC.Disconnect
        TDC.LogOut
        TDC.ReleaseConnection
       
        Set oQTP = CreateObject("QuickTest.Application")
        oQTP.Quit
   
    Else
   
        'Email Start Notification
        If Len(EmailIDs) > 0 Then
            'Connecting to QC. This use QC Sendmail function to email
            Set TDC = CreateObject("TDApiOle80.TDConnection")
            TDC.InitConnectionEx QCURL
            TDC.Login loginID, loginPass
            TDC.Connect QCDomain, QCProject
   
            Set oNet = CreateObject("Wscript.Network")
            LocalPCName = oNet.ComputerName
            Set oNet = Nothing
            varMailBody = "<h1>Test Execution Started</h1><br><br><br>Execution Started for Below TestCases :<br><br>"
            varMailBody = varMailBody & "<br> Test Case(s) : " & TestCaseNames
            varMailBody = varMailBody & "<br> Started at: " & LocalPCName & "<br><br>" & AdditionalComments
            TDC.SendMail EmailIDs, , "Test Execution -> Started @ " & LocalPCName, varMailBody

        End If
   
        Set oQTP = CreateObject("QuickTest.Application")
        oQTP.Launch
        oQTP.Visible = True
        arrTestCaseNames = Split(TestCaseNames, ",")
        For Each TestCase In arrTestCaseNames
            oQTP.Open TestCase, True, False
            oQTP.Test.Run
            oQTP.Test.Close
        Next
   
   
        'Email Execution Completion alert
        If Len(EmailIDs) > 0 Then
            TDC.Connect QCDomain, QCProject
            TDC.SendMail EmailIDs, , "Test Execution -> Completed @ " & LocalPCName, "Execution Completed"
            TDC.Disconnect
            TDC.LogOut
            TDC.ReleaseConnection
        End If


        oQTP.Quit
   
    End If

1 comment:

  1. Hi, I am able to open QTP on remote machine but not able to run the test.

    Can you please help me

    ReplyDelete