'Add the command prompt as a object in QTP OR.
myname=SysExecute("dir")
MsgBox myname
Function SysExecute(ByVal strCmdtoExecute)
Dim Output ' Variant
SystemUtil.CloseProcessByName("cmd.exe")
Wait 2
SystemUtil.Run "cmd", "/K cd c:\ & cls", "", "", 1
Wait 3
sPrompt = window("CommandWindow").GetVisibleText
if(sPrompt <> " ") then
myarray = split(sPrompt,vbCRLF)
if(ubound(myarray)>0) Then
lastline = ubound(myarray)
sPrompt = myarray(lastline)
else
sPrompt = "c:\>"
end if
else
sPrompt = "c:\>"
end if
with window("CommandWindow")
.activate
.type strCmdtoExecute
.type micreturn
end with
i=1
Do While True
cmdOutput = window("CommandWindow").GetVisibleText
myarray = split(cmdOutput,vbCRLF)
if(ubound(myarray)>0) Then
lastline = ubound(myarray)
sNewPrompt = myarray(lastline)
if(StrComp(sPrompt,sNewPrompt,0) = 0) then
For j = 1 to lastline -1
Output = Output & vbcrlf & myarray(j)
Next
Exit do
end if
else
lastline = ubound(myarray)
end if
if(i>15) then 'Exit condition
if(lastline > 3) then
For j = 2 to lastline -1
Output = Output & vbcrlf & myarray(j)
Next
else
Output = " "
end if
Exit do
end if
i=i+1
Loop
SysExecute = Output
window("CommandWindow").Close
Wait 2
Exit function
End Function
Monday
QTP - Matching pattern in string by regular expression
MsgBox(RegExpTest("ab","abhishek"))
Function RegExpTest(patrn, strng)
Dim regEx, Match, Matches ' Create variable.
Set regEx = New RegExp ' Create a regular expression.
regEx.Pattern = patrn ' Set pattern.
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
Set Matches = regEx.Execute(strng) ' Execute search.
For Each Match in Matches ' Iterate Matches collection.
RetStr = RetStr & "Match found at position "
RetStr = RetStr & Match.FirstIndex & ". Match Value is '"
RetStr = RetStr & Match.Value & "'." & vbCRLF
Next
RegExpTest = RetStr
End Function
'If want to search multiple lines
'MsgBox(RegExpTest("is.", "IS1 is2 IS3 is4"))
Function RegExpTest(patrn, strng)
Dim regEx, Match, Matches ' Create variable.
Set regEx = New RegExp ' Create a regular expression.
regEx.Pattern = patrn ' Set pattern.
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
Set Matches = regEx.Execute(strng) ' Execute search.
For Each Match in Matches ' Iterate Matches collection.
RetStr = RetStr & "Match found at position "
RetStr = RetStr & Match.FirstIndex & ". Match Value is '"
RetStr = RetStr & Match.Value & "'." & vbCRLF
Next
RegExpTest = RetStr
End Function
'If want to search multiple lines
'MsgBox(RegExpTest("is.", "IS1 is2 IS3 is4"))
Friday
STAF - Software Test Automation Framework
Installation and setting machine:
STEP;1 : INstall STF in C:\STAF
Step2: create C:\STAF\service folder
Step3: put Stax in the service folder
STEP 4: Install perl and Python
STEP 5:Set classpath add -->C:\STAF\bin\JSTAF.jar;C:\python22\lib;
classpath add -->C:\STAF\bin\JSTAF.jar;C:\python22\lib;C:\perl\lib;
path add -->C:\STAF\bin;C:\Python22;c:\perl\bin;
create a new variable with PYTHONPATH and set the value C:\STAF\bin;
create a new variable STAF_DIR with the value c:\staf;
STEP 6:OPen the staf.cnf file from c:\staf\bin. put line given below
SERVICE STAX LIBRARY JSTAF EXECUTE C:\STAF\services\stax\STAX.jar
SERVICE EVENT LIBRARY JSTAF EXECUTE C:\STAF\services\stax\STAFEvent.jar
Step 7: Set trust level
TRUST LEVEL 5 MACHINE shukr02-RH5
Step 8: comment the line SSL in staf.cnf file
Step9: set the other trust machine.
Step 10: start Staf
Command:
Go to C:\staf folder in command prompt:
1.To Open the commad promt on trusted machine
staf process start process cmd.exe
staf process start process cmd.exe
2. Copy the file from one locatoin to other location:
C:\>STAF local FS COPY FILE "C:\Program Files\file1.txt" TOFILE "C:\Program Files\file2.txt"
STAF local PROCESS START SHELL COMMAND "copy \"C:\Program Files\file1.txt\" \"C:\Program Files\file2.txt\"" WAIT RETURNSTDOUT STDERRTOSTDOUT
3.LIST DIRECTORY ( like ls in Unix)
STAF local FS LIST DIRECTORY "C:\Program Files"
4.More kind of Unix command facility
like more "C:\Program Files\file1.txt"
STAF local PROCESS START SHELL COMMAND "more \"C:\Program Files\file1.txt\"" WAIT RETURNSTDOUT STDERRTOSTDOUT SAMECONSOLE
STAF local FS GET FILE "C:\Program Files\file1.txt"
5.echo this is the string to be parsed > "C:\Program Files\echofile.txt"
if fiile will not there it will craete the file:
this command will replace the content of file and put the string given after echo "this is the string to be parsed "
STAF local PROCESS START SHELL COMMAND "echo this is the string to be parsed > \"C:\Program Filesr\echofile.txt\"" WAIT RETURNSTDOUT STDERRTOSTDOUT
STEP;1 : INstall STF in C:\STAF
Step2: create C:\STAF\service folder
Step3: put Stax in the service folder
STEP 4: Install perl and Python
STEP 5:Set classpath add -->C:\STAF\bin\JSTAF.jar;C:\python22\lib;
classpath add -->C:\STAF\bin\JSTAF.jar;C:\python22\lib;C:\perl\lib;
path add -->C:\STAF\bin;C:\Python22;c:\perl\bin;
create a new variable with PYTHONPATH and set the value C:\STAF\bin;
create a new variable STAF_DIR with the value c:\staf;
STEP 6:OPen the staf.cnf file from c:\staf\bin. put line given below
SERVICE STAX LIBRARY JSTAF EXECUTE C:\STAF\services\stax\STAX.jar
SERVICE EVENT LIBRARY JSTAF EXECUTE C:\STAF\services\stax\STAFEvent.jar
Step 7: Set trust level
TRUST LEVEL 5 MACHINE shukr02-RH5
Step 8: comment the line SSL in staf.cnf file
Step9: set the other trust machine.
Step 10: start Staf
Command:
Go to C:\staf folder in command prompt:
1.To Open the commad promt on trusted machine
staf
staf
2. Copy the file from one locatoin to other location:
C:\>STAF local FS COPY FILE "C:\Program Files\file1.txt" TOFILE "C:\Program Files\file2.txt"
STAF local PROCESS START SHELL COMMAND "copy \"C:\Program Files\file1.txt\" \"C:\Program Files\file2.txt\"" WAIT RETURNSTDOUT STDERRTOSTDOUT
3.LIST DIRECTORY ( like ls in Unix)
STAF local FS LIST DIRECTORY "C:\Program Files"
4.More kind of Unix command facility
like more "C:\Program Files\file1.txt"
STAF local PROCESS START SHELL COMMAND "more \"C:\Program Files\file1.txt\"" WAIT RETURNSTDOUT STDERRTOSTDOUT SAMECONSOLE
STAF local FS GET FILE "C:\Program Files\file1.txt"
5.echo this is the string to be parsed > "C:\Program Files\echofile.txt"
if fiile will not there it will craete the file:
this command will replace the content of file and put the string given after echo "this is the string to be parsed "
STAF local PROCESS START SHELL COMMAND "echo this is the string to be parsed > \"C:\Program Filesr\echofile.txt\"" WAIT RETURNSTDOUT STDERRTOSTDOUT
Wednesday
QTP - Open a process on remote machine
strComputer = "alara01-xp"
'strComputer = "."
'strCommand = "notepad.exe"
'strCommand = "C:\Program Files\HP\QuickTest Professional\bin\QTPro.exe"
'strCommand = "C:\Program Files\HP\QuickTest Professional\bin\QTP.exe"
'c:\Program Files\Mercury Interactive\QuickTest Professional\bin
'strCommand = "c:\Program Files\Mercury Interactive\QuickTest Professional\bin\QTPro.exe"
'strCommand = "C:\Program Files\Internet Explorer\IEXPLORE.exe"
'strCommand = "mspaint.exe"
'strCommand = "IEXPLORE.EXE"
strCommand = "cmd.exe"
Const INTERVAL = "n"
Const MINUTES = 1
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objScheduledJob = objWMIService.Get("Win32_ScheduledJob")
Set objSWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")
objSWbemDateTime.SetVarDate(DateAdd(INTERVAL, MINUTES, Now()))
errReturn = objScheduledJob.Create(strCommand, objSWbemDateTime.Value, False, 0, 0, True, intJobID)
If errReturn = 0 Then
Wscript.Echo "notepad.exe was started with a process ID: " & intJobID
Else
Wscript.Echo "notepad.exe could not be started due to error: " & errReturn
End If
'strComputer = "."
'strCommand = "notepad.exe"
'strCommand = "C:\Program Files\HP\QuickTest Professional\bin\QTPro.exe"
'strCommand = "C:\Program Files\HP\QuickTest Professional\bin\QTP.exe"
'c:\Program Files\Mercury Interactive\QuickTest Professional\bin
'strCommand = "c:\Program Files\Mercury Interactive\QuickTest Professional\bin\QTPro.exe"
'strCommand = "C:\Program Files\Internet Explorer\IEXPLORE.exe"
'strCommand = "mspaint.exe"
'strCommand = "IEXPLORE.EXE"
strCommand = "cmd.exe"
Const INTERVAL = "n"
Const MINUTES = 1
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objScheduledJob = objWMIService.Get("Win32_ScheduledJob")
Set objSWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")
objSWbemDateTime.SetVarDate(DateAdd(INTERVAL, MINUTES, Now()))
errReturn = objScheduledJob.Create(strCommand, objSWbemDateTime.Value, False, 0, 0, True, intJobID)
If errReturn = 0 Then
Wscript.Echo "notepad.exe was started with a process ID: " & intJobID
Else
Wscript.Echo "notepad.exe could not be started due to error: " & errReturn
End If
VBS to launch/Invoke QTP
VBS to launch QTP 9.2 and invoke script automatically
'Code found @ http://www.learnqtp.com/forums/vbs-launch-qtp-invoke-script-automatically-t-417.html
Enter the following code in VBScript editor and save teh file(saves as a VBS file) then you can go to the CMD to run the VBS file or use windows scheduler to schedule for a particular time.This is just an example make sure to change the location of the test script.
'**************************************************************************
'The following script opens a test, configures run options and settings,
'runs the test, and then checks the results of the test run.
'**************************************************************************
Dim qtApp 'As QuickTest.Application 'Declare the Application object variable
Dim qtTest 'As QuickTest.Test 'Declare a Test object variable
Dim qtResultsOpt 'As QuickTest.RunResultsOptions ' Declare a Run Results Options object variable
Const ForReading = 1, ForWriting = 2
Dim fso, f, result
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Regression_Test_Results.txt", ForWriting, True)
Set qtApp = CreateObject("QuickTest.Application") 'Create the Application object
qtApp.Launch 'Start QuickTest
qtApp.Visible = True 'Make the QuickTest application visible
'Set QuickTest run options
qtApp.Options.Run.ImageCaptureForTestResults = "OnError"
qtApp.Options.Run.RunMode = "Fast"
qtApp.Options.Run.ViewResults = False
qtApp.Open "C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Regression_Suite_BA_1\CharitableOrg_Owner_NonQual_GuaDeathBenefit_SurrenderCharges", True ' Open the test in read-only mode
'Set run settings for the test
Set qtTest = qtApp.Test
qtTest.Settings.Run.IterationMode = "rngIterations" 'Run only iterations 2 to 4
qtTest.Settings.Run.StartIteration = 2
qtTest.Settings.Run.EndIteration = 4
qtTest.Settings.Run.OnError = "NextStep" ' Instruct QuickTest to perform next step when error occurs
'Set the results path
Set qtResultsOpt = CreateObject("QuickTest.RunResultsOptions") ' Create the Run Results Options object
qtResultsOpt.ResultsLocation = "C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Regression_Suite_BA_1\CharitableOrg_Owner_NonQual_GuaDeathBenefit_SurrenderCharges\Res1" ' Set the results location
qtTest.Run qtResultsOpt 'Run the test
result= qtTest.LastRunResults.Status
f.Write("Test 1: CharitableOrg_Owner_NonQual_GuaDeathBenefit_SurrenderCharges - ")
f.Write(result)
f.WriteBlankLines(1)
'Code found @ http://www.learnqtp.com/forums/vbs-launch-qtp-invoke-script-automatically-t-417.html
Enter the following code in VBScript editor and save teh file(saves as a VBS file) then you can go to the CMD to run the VBS file or use windows scheduler to schedule for a particular time.This is just an example make sure to change the location of the test script.
'**************************************************************************
'The following script opens a test, configures run options and settings,
'runs the test, and then checks the results of the test run.
'**************************************************************************
Dim qtApp 'As QuickTest.Application 'Declare the Application object variable
Dim qtTest 'As QuickTest.Test 'Declare a Test object variable
Dim qtResultsOpt 'As QuickTest.RunResultsOptions ' Declare a Run Results Options object variable
Const ForReading = 1, ForWriting = 2
Dim fso, f, result
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Regression_Test_Results.txt", ForWriting, True)
Set qtApp = CreateObject("QuickTest.Application") 'Create the Application object
qtApp.Launch 'Start QuickTest
qtApp.Visible = True 'Make the QuickTest application visible
'Set QuickTest run options
qtApp.Options.Run.ImageCaptureForTestResults = "OnError"
qtApp.Options.Run.RunMode = "Fast"
qtApp.Options.Run.ViewResults = False
qtApp.Open "C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Regression_Suite_BA_1\CharitableOrg_Owner_NonQual_GuaDeathBenefit_SurrenderCharges", True ' Open the test in read-only mode
'Set run settings for the test
Set qtTest = qtApp.Test
qtTest.Settings.Run.IterationMode = "rngIterations" 'Run only iterations 2 to 4
qtTest.Settings.Run.StartIteration = 2
qtTest.Settings.Run.EndIteration = 4
qtTest.Settings.Run.OnError = "NextStep" ' Instruct QuickTest to perform next step when error occurs
'Set the results path
Set qtResultsOpt = CreateObject("QuickTest.RunResultsOptions") ' Create the Run Results Options object
qtResultsOpt.ResultsLocation = "C:\Program Files\Mercury Interactive\QuickTest Professional\Tests\Regression_Suite_BA_1\CharitableOrg_Owner_NonQual_GuaDeathBenefit_SurrenderCharges\Res1" ' Set the results location
qtTest.Run qtResultsOpt 'Run the test
result= qtTest.LastRunResults.Status
f.Write("Test 1: CharitableOrg_Owner_NonQual_GuaDeathBenefit_SurrenderCharges - ")
f.Write(result)
f.WriteBlankLines(1)
Monday
EXPORT QC TESTCASES and BUGS in Excel code
Option Explicit
Dim sUserName,sPassword
sUserName = "YOUR_UID"
sPassword = "YOUR_PWD"
Const xlLeft = -4131
Const xlRight = -4152
Const xlCenter = -4108
Const xlGeneral = 1
Dim QCConnection
'Return the TDConnection object.
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
QCConnection.InitConnectionEx "http://YOUR_URLOFQC:8080/qcbin/"
QCConnection.Login sUserName, sPassword
If (QCConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
WScript.Quit
End If
Dim sDomain, sProject
sDomain = "YOUR_Domain"
sProject = "YOUR_Project"
QCConnection.Connect sDomain, sProject
If (QCConnection.Connected <> True) Then
MsgBox "QC Project Failed to Connect to " & sProject
WScript.Quit
End If
Call ExportTestCases()
'Call ExportDefects()
QCConnection.Disconnect
QCConnection.Logout
QCConnection.ReleaseConnection
Function PrintFields(oObject)
Dim FieldsList, Field
Set FieldsList = oObject.Fields
For Each Field In FieldsList
WScript.Echo Field
Next
End Function
Function ExportTestCases()
Dim TestFactory, TestList
Set TestFactory = QCConnection.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all tests.
Dim TestCase, Excel, Sheet
Set Excel = CreateObject("Excel.Application") 'Open Excel
Excel.WorkBooks.Add() 'Add a new workbook
'Get the first worksheet.
Set Sheet = Excel.ActiveSheet
Sheet.Name = "Tests"
With Sheet.Range("A1:H1")
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 15 'Light Grey
End With
Sheet.Cells(1, 1) = "Subject (Folder Name)"
Sheet.Cells(1, 2) = "Test Name (Manual Test Plan Name)"
Sheet.Cells(1, 3) = "Description"
'Sheet.Cells(1, 4) = "Designer (Owner)"
'Sheet.Cells(1, 5) = "Status"
Sheet.Cells(1, 6) = "Step Name"
Sheet.Cells(1, 7) = "Step Description(Action)"
Sheet.Cells(1, 8) = "Expected Result"
'Call PrintFields(TestFactory)
Dim Row
Dim countingSubject
Row = 2
'Iterate through all the tests.
For Each TestCase In TestList
Dim DesignStepFactory, DesignStep, DesignStepList
Set DesignStepFactory = TestCase.DesignStepFactory
Set DesignStepList = DesignStepFactory.NewList("")
countingSubject=0
If DesignStepList.Count = 0 Then
'Save a specified set of fields.
Sheet.Cells(Row, 1).Value = TestCase.Field("TS_SUBJECT").Path
Sheet.Cells(Row, 2).Value = TestCase.Field("TS_NAME")
Sheet.Cells(Row, 3).Value = TestCase.Field("TS_DESCRIPTION")
'Sheet.Cells(Row, 4).Value = TestCase.Field("TS_RESPONSIBLE")
'Sheet.Cells(Row, 5).Value = TestCase.Field("TS_STATUS")
Row = Row + 1
Else
For Each DesignStep In DesignStepList
'Save a specified set of fields.
If countingSubject=0 then
Sheet.Cells(Row, 1).Value = TestCase.Field("TS_SUBJECT").Path
Sheet.Cells(Row, 2).Value = TestCase.Field("TS_NAME")
Sheet.Cells(Row, 3).Value = TestCase.Field("TS_DESCRIPTION")
'Sheet.Cells(Row, 4).Value = TestCase.Field("TS_RESPONSIBLE")
'Sheet.Cells(Row, 5).Value = TestCase.Field("TS_STATUS")
'Save the specified design steps.
Sheet.Cells(Row, 6).Value = DesignStep.StepName
Sheet.Cells(Row, 7).Value = DesignStep.StepDescription
Sheet.Cells(Row, 8).Value = DesignStep.StepExpectedResult
else
Sheet.Cells(Row, 6).Value = DesignStep.StepName
Sheet.Cells(Row, 7).Value = DesignStep.StepDescription
Sheet.Cells(Row, 8).Value = DesignStep.StepExpectedResult
end if
countingSubject=countingSubject+1
Row = Row + 1
Next
End If
'for max number of row delet this code if you want full export
If Row>500 Then
Exit For
End If
Next
'Call PrintFields(DesignStepFactory)
'Excel.Columns.AutoFit
'Save the newly created workbook and close Excel.
'Excel.ActiveWorkbook.SaveAs("C:\" & sProject & "_TESTCASE1.xls")
'Excel.Workbooks.Open("C:\Export_TESTCASE1.xlsx")
Dim objRange
Set objRange = Sheet.UsedRange
'Remove tag in the following lines
Excel.Cells.Replace "'tag_html>'"," "
Excel.Cells.Replace "tag_body>"," "
Excel.Cells.Replace "/tag_html>"," "
Excel.Cells.Replace "/tag_body>"," "
Excel.Cells.Replace "tag_br>"," "
Excel.ActiveWorkbook.SaveAs("C:\" & sProject & "_TESTCASE.xlsx")
Excel.Quit
End Function
Dim sUserName,sPassword
sUserName = "YOUR_UID"
sPassword = "YOUR_PWD"
Const xlLeft = -4131
Const xlRight = -4152
Const xlCenter = -4108
Const xlGeneral = 1
Dim QCConnection
'Return the TDConnection object.
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
QCConnection.InitConnectionEx "http://YOUR_URLOFQC:8080/qcbin/"
QCConnection.Login sUserName, sPassword
If (QCConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
WScript.Quit
End If
Dim sDomain, sProject
sDomain = "YOUR_Domain"
sProject = "YOUR_Project"
QCConnection.Connect sDomain, sProject
If (QCConnection.Connected <> True) Then
MsgBox "QC Project Failed to Connect to " & sProject
WScript.Quit
End If
Call ExportTestCases()
'Call ExportDefects()
QCConnection.Disconnect
QCConnection.Logout
QCConnection.ReleaseConnection
Function PrintFields(oObject)
Dim FieldsList, Field
Set FieldsList = oObject.Fields
For Each Field In FieldsList
WScript.Echo Field
Next
End Function
Function ExportTestCases()
Dim TestFactory, TestList
Set TestFactory = QCConnection.TestFactory
Set TestList = TestFactory.NewList("") 'Get a list of all tests.
Dim TestCase, Excel, Sheet
Set Excel = CreateObject("Excel.Application") 'Open Excel
Excel.WorkBooks.Add() 'Add a new workbook
'Get the first worksheet.
Set Sheet = Excel.ActiveSheet
Sheet.Name = "Tests"
With Sheet.Range("A1:H1")
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 15 'Light Grey
End With
Sheet.Cells(1, 1) = "Subject (Folder Name)"
Sheet.Cells(1, 2) = "Test Name (Manual Test Plan Name)"
Sheet.Cells(1, 3) = "Description"
'Sheet.Cells(1, 4) = "Designer (Owner)"
'Sheet.Cells(1, 5) = "Status"
Sheet.Cells(1, 6) = "Step Name"
Sheet.Cells(1, 7) = "Step Description(Action)"
Sheet.Cells(1, 8) = "Expected Result"
'Call PrintFields(TestFactory)
Dim Row
Dim countingSubject
Row = 2
'Iterate through all the tests.
For Each TestCase In TestList
Dim DesignStepFactory, DesignStep, DesignStepList
Set DesignStepFactory = TestCase.DesignStepFactory
Set DesignStepList = DesignStepFactory.NewList("")
countingSubject=0
If DesignStepList.Count = 0 Then
'Save a specified set of fields.
Sheet.Cells(Row, 1).Value = TestCase.Field("TS_SUBJECT").Path
Sheet.Cells(Row, 2).Value = TestCase.Field("TS_NAME")
Sheet.Cells(Row, 3).Value = TestCase.Field("TS_DESCRIPTION")
'Sheet.Cells(Row, 4).Value = TestCase.Field("TS_RESPONSIBLE")
'Sheet.Cells(Row, 5).Value = TestCase.Field("TS_STATUS")
Row = Row + 1
Else
For Each DesignStep In DesignStepList
'Save a specified set of fields.
If countingSubject=0 then
Sheet.Cells(Row, 1).Value = TestCase.Field("TS_SUBJECT").Path
Sheet.Cells(Row, 2).Value = TestCase.Field("TS_NAME")
Sheet.Cells(Row, 3).Value = TestCase.Field("TS_DESCRIPTION")
'Sheet.Cells(Row, 4).Value = TestCase.Field("TS_RESPONSIBLE")
'Sheet.Cells(Row, 5).Value = TestCase.Field("TS_STATUS")
'Save the specified design steps.
Sheet.Cells(Row, 6).Value = DesignStep.StepName
Sheet.Cells(Row, 7).Value = DesignStep.StepDescription
Sheet.Cells(Row, 8).Value = DesignStep.StepExpectedResult
else
Sheet.Cells(Row, 6).Value = DesignStep.StepName
Sheet.Cells(Row, 7).Value = DesignStep.StepDescription
Sheet.Cells(Row, 8).Value = DesignStep.StepExpectedResult
end if
countingSubject=countingSubject+1
Row = Row + 1
Next
End If
'for max number of row delet this code if you want full export
If Row>500 Then
Exit For
End If
Next
'Call PrintFields(DesignStepFactory)
'Excel.Columns.AutoFit
'Save the newly created workbook and close Excel.
'Excel.ActiveWorkbook.SaveAs("C:\" & sProject & "_TESTCASE1.xls")
'Excel.Workbooks.Open("C:\Export_TESTCASE1.xlsx")
Dim objRange
Set objRange = Sheet.UsedRange
'Remove tag in the following lines
Excel.Cells.Replace "'tag_html>'"," "
Excel.Cells.Replace "tag_body>"," "
Excel.Cells.Replace "/tag_html>"," "
Excel.Cells.Replace "/tag_body>"," "
Excel.Cells.Replace "tag_br>"," "
Excel.ActiveWorkbook.SaveAs("C:\" & sProject & "_TESTCASE.xlsx")
Excel.Quit
End Function
Thursday
QTP - Associate Object repository at run time in QTP
Methods
Add
Adds an object repository file to the specified position in the collection.
Find
Finds the position of the specified object repository file.
MoveToPos
Moves the object repository file entry from the current position to the specified new position.
Remove
Removes the object repository that is located in the specified position.
RemoveAll
Removes all object repository files from the collection.
SetAsDefault
Sets the object repository files associated with the current action as the default files for all new actions.
'************************************************************************************************************************
'Description:
'
'This example opens a test, configures an action's object repositories collection
'and saves the test.
'
'Assumptions:
'There is no unsaved test currently open in QuickTest.
'For more information, see the example for the Test.SaveAs method.
'************************************************************************************************************************
Dim qtApp 'As QuickTest.Application ' Declare the Application object variable
Dim qtRepositories 'As QuickTest.ObjectRepositories ' Declare an action's object repositories collection variable
Dim lngPosition
' Open QuickTest
Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object
qtApp.Launch ' Launch QuickTest
qtApp.Visible = True ' Set QuickTest to be visible
' Open a test and get the "Login" action's object repositories collection
qtApp.Open "C:\Tests\Test1", False, False ' Open a test
Set qtRepositories = qtApp.Test.Actions("Login").ObjectRepositories ' Get the object repositories collection object of the "Login" action
' Add MainApp.tsr if it's not already in the collection
If qtRepositories.Find("C:\MainApp.tsr") = -1 Then ' If the repository cannot be found in the collection
qtRepositories.Add "C:\MainApp.tsr", 1 ' Add the repository to the collection
End If
' If InnerWnd.tsr is moved down the list - place it back at position 1
If qtRepositories.Count > 1 And qtRepositories.Item(2) = "C:\InnerWnd.tsr" Then ' If there's more than one object repository and InnerWnd.tsr is in position 2
qtRepositories.MoveToPos 1, 2 ' Switch between the first two object repositories
End If
' If Debug.tsr is in the collection - remove it
lngPosition = qtRepositories.Find("C:\Debug.tsr") ' Try finding the Debug.tsr object repository
If lngPosition <> -1 Then ' If the object repository was found in the collection
qtRepositories.Remove lngPosition ' Remove it
End If
' Set the new object repository configuration as the default for all new actions
qtRepositories.SetAsDefault ' Set object repositories associated with the "Login" action as the default for all new actions
'Save the test and close QuickTest
qtApp.Test.Save ' Save the test
qtApp.Quit ' Quit QuickTest
Set qtRepositories = Nothing ' Release the action's shared repositories collection
Set qtApp = Nothing ' Release the Application object
'********************
'***************************
'The following example retrieves an object repository's objects and properties,
'looks for specific test objects using several methods, and copies a test object
'to another object repository.
'********************
'***************************
Dim ImageObj, PageObj, RepositoryFrom, RepositoryTo
Set RepositoryFrom = CreateObject("Mercury.ObjectRepositoryUtil")
Set RepositoryTo = CreateObject("Mercury.ObjectRepositoryUtil")
RepositoryFrom.Load "C:\QuickTest\Tests\Flights.tsr"
RepositoryTo.Load "E:\Temp\Tests\Default.tsr"
Function EnumerateAllChildProperties(Root)
'The following function recursively enumerates all the test objects directly under
'a specified parent object. For each test object, a message box opens containing the
'test object's name, properties, and property values.
Dim TOCollection, TestObject, PropertiesCollection, Property, Msg
Set TOCollection = RepositoryFrom.GetChildren(Root)
For i = 0 To TOCollection.Count - 1
Set TestObject = TOCollection.Item(i)
Msg = RepositoryFrom.GetLogicalName(TestObject) & vbNewLine
Set PropertiesCollection = TestObject.GetTOProperties()
For n = 0 To PropertiesCollection.Count - 1
Set Property = PropertiesCollection.Item(n)
Msg = Msg & Property.Name & "-" & Property.Value & vbNewLine
Next
MsgBox Msg
EnumerateAllChildProperties TestObject
Next
End Function
Function EnumerateAllObjectsProperties(Root)
'The following function enumerates all the test objects under a specified object.
'For each test object, a message box opens containing the test object's name,
'properties, and property values.
Dim TOCollection, TestObject, PropertiesCollection, Property, Msg
Set TOCollection = RepositoryFrom.GetAllObjects(Root)
For i = 0 To TOCollection.Count - 1
Set TestObject = TOCollection.Item(i)
Msg = RepositoryFrom.GetLogicalName(TestObject) & vbNewLine
Set PropertiesCollection = TestObject.GetTOProperties()
For n = 0 To PropertiesCollection.Count - 1
Set Property = PropertiesCollection.Item(n)
Msg = Property.Name & "-" & Property.Value & vbNewLine
Next
MsgBox Msg
Next
End Function
Function RenameAllImages(Root)
'The following function sets a new name for all image test objects under a specified object.
Dim TOCollection, TestObject, PropertiesCollection, Property
Set TOCollection = RepositoryTo.GetAllObjectsByClass("Image")
For i = 0 To TOCollection.Count - 1
Set TestObject = TOCollection.Item(i)
RepositoryTo.RenameObject (TestObject, "Image " & i)
RepositoryTo.UpdateObject TestObject
Next
End Function
Function RemoveAllLinks(Root)
'The following function recursively enumerates all the test objects under a specified object.
'It looks for all test objects of class Link and removes them from their parent objects.
Dim TOCollection, TestObject, PropertiesCollection, Property
Set TOCollection = RepositoryFrom.GetChildren(Root)
For i = 0 To TOCollection.Count - 1
Set TestObject = TOCollection.Item(i)
TOClass = TestObject.GetTOProperty("micclass")
If TOClass = "Link" Then
RepositoryFrom.RemoveObject Root, TestObject
End If
EnumerateAllChildProperties TestObject
Next
End Function
Add
Adds an object repository file to the specified position in the collection.
Find
Finds the position of the specified object repository file.
MoveToPos
Moves the object repository file entry from the current position to the specified new position.
Remove
Removes the object repository that is located in the specified position.
RemoveAll
Removes all object repository files from the collection.
SetAsDefault
Sets the object repository files associated with the current action as the default files for all new actions.
'************************************************************************************************************************
'Description:
'
'This example opens a test, configures an action's object repositories collection
'and saves the test.
'
'Assumptions:
'There is no unsaved test currently open in QuickTest.
'For more information, see the example for the Test.SaveAs method.
'************************************************************************************************************************
Dim qtApp 'As QuickTest.Application ' Declare the Application object variable
Dim qtRepositories 'As QuickTest.ObjectRepositories ' Declare an action's object repositories collection variable
Dim lngPosition
' Open QuickTest
Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object
qtApp.Launch ' Launch QuickTest
qtApp.Visible = True ' Set QuickTest to be visible
' Open a test and get the "Login" action's object repositories collection
qtApp.Open "C:\Tests\Test1", False, False ' Open a test
Set qtRepositories = qtApp.Test.Actions("Login").ObjectRepositories ' Get the object repositories collection object of the "Login" action
' Add MainApp.tsr if it's not already in the collection
If qtRepositories.Find("C:\MainApp.tsr") = -1 Then ' If the repository cannot be found in the collection
qtRepositories.Add "C:\MainApp.tsr", 1 ' Add the repository to the collection
End If
' If InnerWnd.tsr is moved down the list - place it back at position 1
If qtRepositories.Count > 1 And qtRepositories.Item(2) = "C:\InnerWnd.tsr" Then ' If there's more than one object repository and InnerWnd.tsr is in position 2
qtRepositories.MoveToPos 1, 2 ' Switch between the first two object repositories
End If
' If Debug.tsr is in the collection - remove it
lngPosition = qtRepositories.Find("C:\Debug.tsr") ' Try finding the Debug.tsr object repository
If lngPosition <> -1 Then ' If the object repository was found in the collection
qtRepositories.Remove lngPosition ' Remove it
End If
' Set the new object repository configuration as the default for all new actions
qtRepositories.SetAsDefault ' Set object repositories associated with the "Login" action as the default for all new actions
'Save the test and close QuickTest
qtApp.Test.Save ' Save the test
qtApp.Quit ' Quit QuickTest
Set qtRepositories = Nothing ' Release the action's shared repositories collection
Set qtApp = Nothing ' Release the Application object
'********************
'***************************
'The following example retrieves an object repository's objects and properties,
'looks for specific test objects using several methods, and copies a test object
'to another object repository.
'********************
'***************************
Dim ImageObj, PageObj, RepositoryFrom, RepositoryTo
Set RepositoryFrom = CreateObject("Mercury.ObjectRepositoryUtil")
Set RepositoryTo = CreateObject("Mercury.ObjectRepositoryUtil")
RepositoryFrom.Load "C:\QuickTest\Tests\Flights.tsr"
RepositoryTo.Load "E:\Temp\Tests\Default.tsr"
Function EnumerateAllChildProperties(Root)
'The following function recursively enumerates all the test objects directly under
'a specified parent object. For each test object, a message box opens containing the
'test object's name, properties, and property values.
Dim TOCollection, TestObject, PropertiesCollection, Property, Msg
Set TOCollection = RepositoryFrom.GetChildren(Root)
For i = 0 To TOCollection.Count - 1
Set TestObject = TOCollection.Item(i)
Msg = RepositoryFrom.GetLogicalName(TestObject) & vbNewLine
Set PropertiesCollection = TestObject.GetTOProperties()
For n = 0 To PropertiesCollection.Count - 1
Set Property = PropertiesCollection.Item(n)
Msg = Msg & Property.Name & "-" & Property.Value & vbNewLine
Next
MsgBox Msg
EnumerateAllChildProperties TestObject
Next
End Function
Function EnumerateAllObjectsProperties(Root)
'The following function enumerates all the test objects under a specified object.
'For each test object, a message box opens containing the test object's name,
'properties, and property values.
Dim TOCollection, TestObject, PropertiesCollection, Property, Msg
Set TOCollection = RepositoryFrom.GetAllObjects(Root)
For i = 0 To TOCollection.Count - 1
Set TestObject = TOCollection.Item(i)
Msg = RepositoryFrom.GetLogicalName(TestObject) & vbNewLine
Set PropertiesCollection = TestObject.GetTOProperties()
For n = 0 To PropertiesCollection.Count - 1
Set Property = PropertiesCollection.Item(n)
Msg = Property.Name & "-" & Property.Value & vbNewLine
Next
MsgBox Msg
Next
End Function
Function RenameAllImages(Root)
'The following function sets a new name for all image test objects under a specified object.
Dim TOCollection, TestObject, PropertiesCollection, Property
Set TOCollection = RepositoryTo.GetAllObjectsByClass("Image")
For i = 0 To TOCollection.Count - 1
Set TestObject = TOCollection.Item(i)
RepositoryTo.RenameObject (TestObject, "Image " & i)
RepositoryTo.UpdateObject TestObject
Next
End Function
Function RemoveAllLinks(Root)
'The following function recursively enumerates all the test objects under a specified object.
'It looks for all test objects of class Link and removes them from their parent objects.
Dim TOCollection, TestObject, PropertiesCollection, Property
Set TOCollection = RepositoryFrom.GetChildren(Root)
For i = 0 To TOCollection.Count - 1
Set TestObject = TOCollection.Item(i)
TOClass = TestObject.GetTOProperty("micclass")
If TOClass = "Link" Then
RepositoryFrom.RemoveObject Root, TestObject
End If
EnumerateAllChildProperties TestObject
Next
End Function
Subscribe to:
Posts (Atom)