怎样将qtp report导入到excel中？需要先创建测试...

Set Excel1=CreateObject("Excel Application")
你是不是少了一个点了啊~

同问啊 ， 没人解答。。。

Function TestResult(runresult)
'创建AOM自动化模型对象
Set qtapp=CreateObject("quicktest.application")
'获取测试用例最终测试结果
TestResult=runresult
Select Case runresult
    Case "1"
            RunResultState="Failed"
   Case "0"
            RunResultState="Passed"
   Case micDone
            RunResultState="Done"
   Case micWarning
            RunResultState="Warning"   
   Case else
            'Everything is fine
'   print "结果生成失败,运行结果可能为其他情况"
End Select
'RunResult="Passed"
 
'创建EOM自动化模型对象
set excelapp=CreateObject("excel.application")
excelapp.Visible=false

'获取当前Action名
oActionName=Environment.Value("ActionName")
'自动化测试用例模板e799bee5baa6e59b9ee7ad94363存放目录
ExcelFilePath="D:\QTPFrameWork\自动化测试用例\自动化测试用例模板.xls"
'自动化测试用例模板Sheet名
ImportSheet="用例"
'将Excel动态导入到DataTable中
DataTable.ImportSheet ExcelFilePath,ImportSheet,oActionName
'打开自动化测试用例模板
excelapp.Workbooks.Open(ExcelFilePath)
'获取Excel中第一项的Sheet对象
Set osheet=excelapp.Sheets.Item(1)

'DataTable中总行数
getrowcount=DataTable.GetSheet(oActionName).GetRowCount
For n=1 to getrowcount
TestCaseName=DataTable.GetSheet(oActionName).GetParameter("TestCaseName").ValueByRow(n)
'print TestCaseName&oActionName

If TestCaseName=oActionName Then
'print RunResult
    osheet.cells(n+1,20)=RunResultState
                  If RunResultState="Failed" Then
                     osheet.cells(n+1,20).interior.ColorIndex = 3'红色
                  End If
                  If RunResultState="Passed" Then
                     osheet.cells(n+1,20).interior.ColorIndex = 4'绿色
                  End If
       If RunResultState="Warning" Then
                     osheet.cells(n+1,20).interior.ColorIndex = 45'橘黄
                  End If
      If RunResultState="Done" Then
                     osheet.cells(n+1,20).interior.ColorIndex = 48'灰色
                  End If
      If RunResultState="Stop" Then
                     osheet.cells(n+1,20).interior.ColorIndex = 33'天蓝色
                  End If

End If

Next

 

'ImportSheetName=InputBox("请输入保存为文件的名称 (.xls),文件后缀名不需要输入,默认路径为：D:\QTPFrameWork\自动化测试用例\")
'If ImportSheetName="" Then
'                       ExitActionIteration
'            else
                    ImportSheetPath="D:\QTPFrameWork\自动化测试用例\自动化测试用例模板(运行结果).xls"

'                  End If

excelapp.DisplayAlerts=false
excelapp.save ImportSheetPath
excelapp.DisplayAlerts=true
excelapp.Quit

Set qtapp=nothing
Set excelapp=nothing
End Function

'Function test2(name2)
''Dim myname
'myname=test1("dulei")
'msgbox  myname
'End Function
'
'test2(name2)
'
'Function test1(name1)
'   test1=name1
'End Function

 

你可以在检查点函数中调用这个函数，不论成功还是失败都会执行TestResult函数
 

'读Excel文件元素
Public Function QTP_Read_Excel(pathway,sheetname,x,y)
7a64e58685e5aeb9333Dim srcData,srcDoc,ret
set srcData = CreateObject("Excel.Application")
srcData.Visible = True
set srcDoc = srcData.Workbooks.Open(pathway)
srcDoc.Worksheets(sheetname).Activate
ret = srcDoc.Worksheets(sheetname).Cells(x,y).value
srcData.Workbooks.Close
Window("text:=Microsoft Excel").Close
QTP_Read_Excel = ret
End Function

写Excel文件元素并保存退出
Public Function QTP_Write_Excel(pathway,sheetname,x,y,content)
Dim srcData,srcDoc,sp1,sp2,num,use,a1,a2,a3
set srcData = CreateObject("Excel.Application")
srcData.Visible = True
set srcDoc = srcData.Workbooks.Open(pathway)
srcDoc.Worksheets(sheetname).Activate
srcDoc.Worksheets(sheetname).Cells(x,y).value = content

' sp1 = Split(pathway,".")
' sp2 = Split(sp1(0),"\")
' num = UBound(sp2)
' use = sp2(num)

' Set a1 = Description.Create()
' a1("text").value="Microsoft Excel - " + use + ".xls"
' a1("window id").value="0"

' Set a3 = Description.Create()
' a3("Class Name").value="WinObject"
' a3("text").value= use + ".xls"

' Window(a1).WinObject(a3).Type micCtrlDwn + "s" + micCtrlUp

Dim WshShell
Set WshShell=CreateObject("Wscript.Shell")
WshShell.SendKeys "^s"
wait(1)

srcData.Workbooks.Close
Set srcDoc = nothing

Window("text:=Microsoft Excel").Close
End Function