'*******************************************************************    
        Dim ExcellApp                                                    '<--As Excel.Application
        Dim excelSheet                                                   '<--As Excel.worksheet
        Dim workbook                                                     '<--As Excel.workbook
        Dim excelbook
        Dim a
        a=now
        a=Cstr(a)
        s = Utilities.StringReplace(a, ":", "-",3)
        s=mid(s,1,len(s)-3)
        Set ExcelApp = CreateObject("Excel.Application")
        Set ExcellApp = CreateExcel(result,myvar)
        ExcellApp.Activeworkbook.saveAs "C:\"+"？？？？测试"+s+".xls"
        ExcellApp.Quit
        Set ExcellApp = nothing
 end sub
'*******************************************************************

 Function CreateExcel(result,myvar)                                      '<--As Excel.Application
          Dim excelSheet                                                 '<--As Excel.worksheet
          Set ExcelApp = CreateObject("Excel.Application")               '<--Create a new excel Object
              ExcelApp.Workbooks.Add                                     '<--创建表头
              ExcelApp.Visible = True
          Set CreateExcel = ExcelApp
          Set NewSheet = ExcelApp.Sheets.Item(1)
              row=1
              NewSheet.Name = "NetTestTools测试结果"
              NewSheet.Rows(1).Font.Bold = True
              NewSheet.Columns("A:A").ColumnWidth = 40
              NewSheet.Columns("B:B").ColumnWidth = 50
              NewSheet.Columns("B:B").HorizontalAlignment = -4108
              NewSheet.Columns("C:C").ColumnWidth = 10
              NewSheet.Columns("C:C").HorizontalAlignment = -4108
              NewSheet.Columns("D:D").ColumnWidth = 20
              NewSheet.Columns("D:D").HorizontalAlignment = -4108
              NewSheet.Cells(row,1)="测试项目ID序号"
              NewSheet.Cells(row,2)="错误信息"
              NewSheet.Cells(row,3)="测试结果"
              NewSheet.Cells(row,4)="测试时间"
              NewSheet.Cells(row,5)="备    注"
        '''''''''''''''''''''
    for i=2 to 72
          if  result(i-1)="" then                                          '<--写正确信息
              ExcelApp.Application.Visible = True
              ExcelApp.Windows(1).Visible = True
              ' add a new Workbooks and a new Sheet
              'Set NewSheet = ExcelObj.Sheets.Item(1)
              Set NewSheet = ExcelApp.Sheets.Item(1)
             'row=1
              NewSheet.Name = "NetTestTools测试结果"
              NewSheet.Rows(1).Font.Bold = True 
              NewSheet.rows(i).font.colorindex=5
              'NewSheet.rows(i).font.colorindex=5
              'NewSheet.Cells(i,1)="ID"+cstr(j)
              NewSheet.Cells(i,1)="ID"+cstr(i-1)+myvar(i-1)
          NewSheet.Cells(i,2)="测试已完成"
          NewSheet.Cells(i,3)="Pass"
              NewSheet.Cells(i,4)=Now
              'ExcelObj.Save
             'ExcelObj.close
          else
              ExcelApp.Application.Visible = True                        '<--写错误信息
              ExcelApp.Windows(1).Visible = True
              'add a new Workbooks and a new Sheet
              'Set NewSheet = ExcelObj.Sheets.Item(1)
              Set NewSheet = ExcelApp.Sheets.Item(1)
             'row=1
              NewSheet.Name = "NetTestTools测试结果"
              NewSheet.Rows(i).Font.Bold = True
              NewSheet.rows(i).font.colorindex=3
              NewSheet.Cells(i,1)="ID"+cstr(i-1)+myvar(i-1)
          NewSheet.Cells(i,2)=result(i-1)
          NewSheet.Cells(i,3)="Fail"
              NewSheet.Cells(i,4)=Now
              'ExcelObj.Save
             'ExcelObj.close
           end if    
    next
End Function

        NewSheet.Columns("B:C").WrapText = 1
        NewSheet.Columns("B:C").Orientation = 0
        NewSheet.Columns("B:C").AddIndent = 0
        NewSheet.Columns("B:C").ShrinkToFit = 0
        NewSheet.Columns("B:C").MergeCells = 0

  Dim xl
  打开excel文件
  Function OpenExcelFile(strFilePath)
  Set xl = CreateObject("Excel.Application")
  xl.Workbooks.Open strFilePath
  End Function
  获得指定单元格数据
  Function GetCellData(strSheet,rwIndex,colIndex)
  GetCellData = xl.WorkSheets(strSheet).Cells(rwIndex,colIndex)
  End Function
  填充单元格数据
  Function PutCellData(strSheet,rwIndex,colIndex,varData)
  xl.WorkSheets(strSheet).Cells(rwIndex,colIndex) = varData
  End Function
  保存并推出
  Function SaveAndQuit()
  xl.Activeworkbook.save
  xl.Quit
  Set xl = nothing
  End Function

 以下是我用QTP进行Excel数据的读取,希望可以给找这方面资料的朋友一点帮助,但也有可能代码有错误,请务必指出!以下是代码:

Option explicit 51Testing软件测试网nb$XZ%_([BbO
Dim srcData,srcDoc,i,j51Testing软件测试网9U4TN*v"E
set srcData = CreateObject("Excel.Application")
n-eT ^E;l6c5re B94129srcData.Visible = true
5C Oj(d:E Ac6W0r0Nk94129set srcDoc = srcData.Workbooks.Open("D:\test\calc.xls")51Testing软件测试网\J0kety ^'Q
       srcDoc.Worksheets("Sheet1").Activate
@\3d4a#_R
Du94129    Dim myarray(7,4),temp
Re;\)c:o @ zt5x+h7y94129    Dim str51Testing软件测试网 S@(I.`2Q3w}
    For i=2 to 7
N$iLG)C'A8~!h94129     For j=1 to 4

L
wPL!HEK94129              myarray(i,j)= srcDoc.Worksheets("Sheet1").Cells(i,j).value 51Testing软件测试网3w`|v`:aZ F;_
     Select Case j
ff!h BI,\#g6w94129     Case "1" 51Testing软件测试网|q*{FX;r+|;W"q
       str=str&myarray(i,j)&" "
h:N9kFM%ja94129    Case "2"51Testing软件测试网W c6Y&M6b
      temp=myarray(i,j)51Testing软件测试网@1J nTHn| r$qM&oK
   Case "3"51Testing软件测试网s5hE!Mn`8S_4nu
    str=str&myarray(i,j)&" "&temp51Testing软件测试网jc_g'NU
     Case "4"51Testing软件测试网HG2~.o:Cu
      str=str&" = "&myarray(i,j)51Testing软件测试网"w B:ONrt!Rq W
     End Select

wmN5H_94129    Next
4?0I K.M%y])T5F ~/j94129    str=str&chr(13)
8G`;\X/`k94129      Next51Testing软件测试网/Mw(E4r1F/|8b
   srcData.Workbooks.Close51Testing软件测试网!T.V3k3d'v PS
   msgbox str

类似DATATABLE的GETROWCOUNT方法