AOM+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