利用QTP的AOM结合Excel实现脚本批量执行（简易）

    QTP脚本编写完后需要执行，批量执行有很多的方式：框架支持、批量执行工具（例如qtp的Test batch runner）、或者自己编写一个脚本执行等，以下是脚本是利用QTP的AOM结合Excel实现简易的脚本批量自动执行，在这里抛一个"转"，希望引出更多的"  玉".
大致的实现思路如下：
1.在excel的sheet1中的第一行单元格中输入"TestCaseName"，将其作为需要执行的脚本的标记
2.按照事先组织好的脚本执行顺序，在"TestCaseName"列下单元格中依次输入QTP脚本名称
3.利用vbs读取excel中的脚本名称,利用qtp的AOM调用QTP实现脚本的自动执行

以下是具体脚本，保存为vbs，根据脚本的存放位置及excel批量文件的位置修改相应的路径即可：
'-----------------------------------------------------------------------------
On Error Resume Next
TestCaseFilePath="D:\QTPAtuomationTestFrame\Batch\BatchJob.xlsx" '设置测试用例批量文件完整路径
TestScriptPath="D:\QTPAtuomationTestFrame\TestScript\" '测试脚本存放目录

Set bjExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open TestCaseFilePath
Set Sheet = objExcel.Sheets.Item(1)
Set FindTitle = oSheet.UsedRange.Find("TestCaseName")
maxRowsCount = oSheet.UsedRange.Rows.Count
TitleColumnNum = FindTitle.Column
if Err.Number<>0 Then
Else
 Message = RunTest(maxRowsCount,TitleColumnNum)
 Call WriteLog(Message)
End If
objExcel.Workbooks.Close
objExcel.Quit
Set FindTitle = Nothing
Set Sheet = Nothing
Set bjExcel = Nothing

' 执行脚本
Function RunTest(maxRowsCount,TitleColumnNum)
 On Error Resume Next
 '启动QTP
 Set QTP = CreateObject("Quicktest.Application")
 QTP.Launch
 QTP.Visible = True
 While Not QTP.Launched
 Wend
 If Err.Number<>0 Then
  Exit Function
 Else
  For i=2 To maxRowsCount
   TestCaseName = Trim(oSheet.cells(i,TitleColumnNum).value)
   if TestCaseName <>"" then
    QTP.Open  TestScriptPath & TestCaseName
    If Err.Number<>0 Then
     ScriptNameErr=ScriptNameErr & TestCaseName & vbCrLf
     TestCaseName=""
     Err.Clear
    Else
     QTP.Test.Run
     QTP.Test.Close 
    End if 
   end if  
   If Err.Number<>0 Then
    RunTestErr=RunTestErr & TestCaseName & vbCrLf
    Err.Clear
   Else
    If TestCaseName="" Then
    Else
     RunTestSucc=RunTestSucc & TestCaseName & vbCrLf
    End If
   End If
  Next
 QTP.Quit
 Set QTP = Nothing
 End If
 RunTest = "已执行脚本:"&vbCrLf& RunTestSucc &vbcrlf&"未执行脚本:"&vbCrLf& RunTestErr &vbcrlf&"脚本未找到:"&vbCrLf& ScriptNameErr
End Function

' 写日志
Sub WriteLog(Message)
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set LogFile = FSO.OpenTextFile("D:\QTPAtuomationTestFrame\TestResult\runtime.log",8,True)
 LogFile.Write Now&vbCrLf&Message
 Set LogFile = Nothing
 Set FSO = Nothing
End Sub