QTP Automation Object Model

We use QTP AOM to automate QTP execution  Below is sample AOM Code which load all the libary , SOR at run time  Input excel contains Testcase name, Run status etc. We can use this script from scheduler to execute QTP execution without any manual intervention. 

Option Explicit
Dim objQTPApp 'Declares the Application Object Variable
Dim objQTPTest 'Declares a Test Object Variable
Dim objQTPResultsOpt 'Declares a Results Option Variables
Dim objQTPLibraries '' Declare a test's libraries collection variable
Dim objQTPRepositories ''Declare an action's object repositories collection variable
Dim objInputDataFile,objCurWorksheet
Dim strInputDataFilePath,strSuiteInputDataFilePath,strTestScriptFolderPath,strLibraryFileFolder,strObjRepositoryFolder
Dim intRowCnt,intCurRow,strExeKeyword,strTestScriptsName,strResultStatus,strExectionResultPath

strSuiteInputDataFilePath="\\QA Automation\Input Data\COX Test Automation Suite.xls"
strTestScriptFolderPath="\\QA Automation\Test Scripts\"
strLibraryFileFolder="\\QA Automation\Functions\"
strObjRepositoryFolder="\\QA Automation\Object Repository\"
strExectionResultPath="\\QA Automation\Execution Report\Suite Execution Report_"&Replace(Replace(Replace(Now,"/","-")," ","_"),":","-")

Set objQTPApp=CreateObject("QuickTest.Application") ' Creating QTP AOM object
objQTPApp.Launch
objQTPApp.Visible =True

' Set QuickTest run options
objQTPApp.Options.Run.ImageCaptureForTestResults = "OnError"
objQTPApp.Options.Run.RunMode = "Normal"
objQTPApp.Options.Run.ViewResults = False

'Creating an Excel Object  For Readnig Input Data
Set objInputDataFile=CreateObject("Excel.Application")
'Opening Input data Excel in Read - Write Mode
objInputDataFile.Workbooks.Open strSuiteInputDataFilePath,True,True
Set objCurWorksheet=objInputDataFile.ActiveWorkbook.Worksheets(1)
intRowCnt = objCurWorksheet.UsedRange.Rows.Count
intKeyWordCol=5 ' Column 5 Holds the Keyword like Yes or No
intTestNamecol=4 ' Column 4 Holds the TestCase name same to Testscript name

For intCurRow=2 to intRowCnt
    strExeKeyword=objCurWorksheet.Cells(intCurRow,intKeyWordCol)
If LCase(Trim(strExeKeyword))="yes" Then
    strTestScriptsName=objCurWorksheet.Cells(intCurRow,intTestNamecol)
objQTPApp.Open strTestScriptFolderPath&strTestScriptsName, False, False
Set objQTPTest= objQTPApp.Test
Set objQTPLibraries=objQTPTest.Settings.Resources.Libraries
objQTPLibraries.RemoveAll
objQTPLibraries.Add strLibraryFileFolder&"Framework.qfl"
objQTPLibraries.Add strLibraryFileFolder&"EnvVariable.qfl"
Set objQTPRepositories=objQTPTest.Actions("Action1").ObjectRepositories
objQTPRepositories.RemoveAll
objQTPRepositories.Add strObjRepositoryFolder&"SharedRep.tsr"
objQTPTest.Save
Set objQTPResultsOpt=CreateObject("QuickTest.RunResultsOptions")
objQTPResultsOpt.ResultsLocation="<TempLocation>"
objQTPTest.Run  objQTPResultsOpt
strResultStatus=objQTPTest.LastRunResults.Status
If  strResultStatus="Warning" Then
strResultStatus="Passed"
End If
objCurWorksheet.Cells(intCurRow,6)=strResultStatus


End If
Next

objInputDataFile.Activeworkbook.SaveAs strExectionResultPath
objInputDataFile.Activeworkbook.Close
objInputDataFile.Quit

Set objQTPResultsOpt=Nothing
Set objQTPTest=Nothing
Set objQTPRepositories=Nothing
Set objQTPLibraries=Nothing

objQTPApp.Quit
Set objQTPApp= Nothing
Set objInputDataFile=Nothing
Set objCurWorksheet=Nothing