QTP Driver

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

'Get project path
Dim projectPath
projectPath = getProjectPath()&"\"

Call driver()

Function driver()
        sourceDataFile = projectPath&"TestSet.xls"
        sourceDataSheet = "TestCases"
        TestCasePath = projectPath&"TestCase"
        frameUtilFolder = projectPath&"FrameUtil"
        'Load all vbs file under FramwUtil folder
        Call ImportUtilFun(frameUtilFolder)
        XmlLogPrint "<?xml version=""1.0"" encoding=""GB2312""?>"
        
        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.CaptureForTestResults = "OnError"
        qtApp.Options.Run.RunMode = "Fast"
        qtApp.Options.Run.ViewResults = False

       ' Create an instance to operate excel
        Dim excelInstance
        Set excelInstance = new ExcelOperation
        excelInstance.OpenWorkbook sourceDataFile, sourceDataSheet

        Dim row
        row =2
        IDX = Trim(excelInstance.GetCellValue(row, 1))
        XmlLogPrint "<TestCase>"
        Do
           ' If the IDX value is "√", run it,
            If StrComp(IDX, "√")=0 Then
                TestCaseSubFolder = Trim(excelInstance.GetCellValue(row, 2))
                TestCaseName = Trim(excelInstance.GetCellValue(row, 3))
                XmlLogPrint "<"&TestCaseName&">"
                Call RunTestCase(TestCasePath&"\"&TestCaseSubFolder&"\"&TestCaseName, TestCaseName)
                XmlLogPrint "</"&TestCaseName&">"
                 row = row +1
                 IDX = Trim(excelInstance.GetCellValue(row, 1))
            ElseIf StrComp(IDX, "×")=0 Then
                 row = row +1
                 IDX = Trim(excelInstance.GetCellValue(row, 1))
            Else
                Exit Do
            End If
        Loop While IDX<>""
        XmlLogPrint "</TestCase>"
        
        qtTest.Close
        Set qtResultsOpt = Nothing ' Release the Run Results Options object
        Set qtTest = Nothing ' Release the Test object
        qtApp.quit
        Set qtApp = Nothing ' Release the Application object
    Set excelInstance = nothing
End Function

Function RunTestCase(testCasePath, TestCaseName)
        qtApp.Open testCasePath, False, True  '
        Set qtTest = qtApp.Test

        ' Set folder path
        If qtApp.Folders.Find(projectPath) = -1 Then ' If the folder is not found in the collection
            qtApp.Folders.RemoveAll
            qtApp.Folders.Add(projectPath)
            ' Save setting
            qtApp.Test.Save
        Else
                ' set run settings for the test
                Set qtResultsOpt = CreateObject("QuickTest.RunResultsOptions")
                qtResultsOpt.ResultsLocation = projectPath&"\Result\"&TestCaseName'
                qtTest.Run qtResultsOpt, True
                XmlLogPrint qtTest.LastRunResults.Status
               ErrorXmlPrint()
         End If
End Function