'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
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
Hi, I am able to open QTP on remote machine but not able to run the test.
ReplyDeleteCan you please help me