用QTP去加载Excel到Global的Datatable

qdd6501

用QTP去加载Excel到Global的Datatable里去的时候一般的excel能加载进来，可是有些excel却加载进来了Global表里却没有看到数据，或者加载的时候会报错，然后qtp就死掉了，必须关掉进程才行。也不是这个excel太大的缘故，不知道是怎么回事了？

qdd6501

代码是这样的：           

               strDatafile = glbPREEXEC & "Exposure Report_0104release_6.xls"  ’这个路径取的是对的
        strSheetName = 1
        DataTable.ImportSheet strDataFile,1,1
        DataTable.GetSheet(1)

lyscser

是EXCEL的Sheet过多导致的，这个问题比较常见，解决方法如下：

1. 
   
2. '************************************************************************
   
3. '设计说明： 用于将EXCEL中某个SHEET单独COPY出来到一个临时的文件中，从临时文件导入DATATABLE，避免SHEET过多导致的EXCEL出错
   
4. '程序输入：
   
5. '  1. appointedFile -- 原EXCEL
   
6. '  2. appointedSheet -- 原EXCEL的SHEET
   
7. '  3. newSheet -- 新的EXCEL临时SHEET
   
8. '程序输出： 将指定路径下的指定EXCEL的指定SHEET导入DataTable
   
9. '设计人员： 刘毅（LIUYI）
   
10. '设计时间： 2008-11-05
    
11. '调用举例： impXls "D:\test.xls","原始SHEET","新的SHEET"
    
12. '************************************************************************
    
13. Public Function impXls(appointedFile,appointedSheet,newSheet)
    
14. On Error Resume Next
    
15. Dim tmpName:tmpName = Environment.Value("SystemTempDir") & "\" & GenerateUniqueStr(30) & ".xls"
    
16. Dim bolVal:bolVal = False
    
17. 
    
18. Set fObject = CreateObject("Scripting.FileSystemObject")
    
19. If  Not fObject.FileExists(appointedFile) Then
    
20. Repor micFail,"参数文件不存在：",appointedFile
    
21. Set fObject = Nothing
    
22. Exit Function
    
23. End If
    
24. 
    
25. If fObject.FileExists(tmpName) Then
    
26. fObject.DeleteFile(tmpName)
    
27. End If
    
28. 
    
29. Set ExcelApp = CreateObject("Excel.Application")
    
30. ExcelApp.Application.Visible = False
    
31. ExcelApp.DisplayAlerts = False
    
32. Set newBook = ExcelApp.Workbooks.Open (appointedFile,False,True)
    
33. newBook.Worksheets(appointedSheet).Copy
    
34. Set tempBook = ExcelApp.ActiveWorkbook
    
35. tempBook.SaveAs tmpName,1
    
36. Set tempBook = Nothing
    
37. ExcelApp.Quit
    
38. Set ExcelApp = Nothing
    
39. DataTable.AddSheet newSheet
    
40. DataTable.ImportSheet tmpName,appointedSheet,newSheet
    
41. 
    
42. If  fObject.FileExists(tmpName) Then
    
43. fObject.DeleteFile(tmpName)
    
44. End If
    
45. 
    
46. bolVal = ErrorHandle()
    
47. 
    
48. If  bolVal Then
    
49. Reporter ReportEvent micPass,"impXls导入参数成功：","文件【" & appointedFile & "】的【" & appointedSheet & "】页已经导入到【" & newSheet & "】"  
    
50. End If
    
51. 
    
52. Set fObject = Nothing
    
53. impXls = bolVal
    
54. End Function
    

复制代码

lyscser

补充被调用函数一组：

1. 
   
2. '************************************************************************
   
3. '设计说明： 根据日期、时间和两组随机数生成相对较为唯一的字符串，常用于文件的非覆盖保存'程序输入：
   
4. '             1. circleNumber -- 循环次数
   
5. '程序输出： 日期、时间、随机数、随机数的拼接字符串如：20110107_161003_93778_47149
   
6. '设计人员： 刘毅（LIUYI）
   
7. '设计时间： 2011-01-07
   
8. '调用举例： Printer GenerateUniqueStr("30")
   
9. '************************************************************************
   
10. 
    
11. Public Function GenerateUniqueStr(circleNumber)
    
12.          If     Trim(circleNumber) = "" Then
    
13.                    circleNumber = randomnumber.Value(20,50)
    
14.          Else
    
15.                    If     circleNumber < 11 Then
    
16.                             circleNumber = circleNumber + 20
    
17.                    End If        
    
18.          End If
    
19.          
    
20.          randomNo = randomnumber.Value(10,Abs(circleNumber))
    
21.          For i = 1 to randomNo
    
22.                    randomNum1 = randomnumber.Value(10000,99999)
    
23.                    randomNum2 = Int((99999-10000+1)*rnd+10000)
    
24.          Next
    
25.          
    
26.          GenerateUniqueStr = FormatDate(Now,"yyyymmdd_hh24miss")&"_"&randomNum1&"_"&randomNum2
    
27. End Function
    
28. 
    
29. '******************************************************************************
    
30. '设计说明： （模仿PL/SQL同名函数）将字符串扩展到指定长度，用fillWithChar从左边循环填充，本函数不会截短appointedStr
    
31. '程序输入：
    
32. '                  1. appointedStr -- 字符串
    
33. '                  2. appointedwidth -- 指定的长度
    
34. '                  3. fillWithChar -- 填充字符
    
35. '程序输出：
    
36. '设计人员： 刘毅（LIUYI）
    
37. '设计时间： 2011-01-04
    
38. '调用举例： msgbox OracleLPadStr(Second(theTime), 2, "0")
    
39. '******************************************************************************
    
40. 
    
41. Function OracleLPadStr(appointedStr, appointedwidth, fillWithChar)
    
42.          OracleLPadStr = ExpandString(fillWithChar, appointedwidth - Len(appointedStr)) & appointedStr
    
43. End Function
    
44. 
    
45. '******************************************************************************
    
46. '设计说明： （模仿PL/SQL同名函数）将字符串扩展到指定长度，用fillWithChar从左边循环填充，本函数不会截短appointedStr
    
47. '程序输入：
    
48. '                  1. appointedStr -- 字符串
    
49. '                  2. appointedwidth -- 指定的长度
    
50. '                  3. fillWithChar -- 填充字符
    
51. '程序输出：
    
52. '设计人员： 刘毅（LIUYI）
    
53. '设计时间： 2011-01-04
    
54. '调用举例： msgbox OracleLPadStr(Second(theTime), 2, "0")
    
55. '******************************************************************************
    
56. 
    
57. Function OracleRPadStr(appointedStr, appointedwidth, fillWithChar)
    
58.          OracleRPadStr = appointedStr & ExpandString(fillWithChar, appointedwidth - Len(appointedStr))
    
59. End Function
    
60. 
    
61. '******************************************************************************
    
62. '设计说明： 将appointedStr反复叠加，使其长度扩展（或缩小）到appointedwidth
    
63. '程序输入：
    
64. '                  1. appointedStr -- 字符串
    
65. '                  2. appointedwidth -- 指定的长度
    
66. '程序输出：
    
67. '设计人员： 刘毅（LIUYI）
    
68. '设计时间： 2011-01-04
    
69. '调用举例： ExpandString("bye",7) 返回 byebyeb ； ExpandString("bye",2)返回 by
    
70. '******************************************************************************
    
71. 
    
72. Private Function ExpandString(appointedStr, appointedwidth)
    
73.          Dim width0, repeat_times, reminder, i, result
    
74.          
    
75.          If       appointedwidth <= 0 Then
    
76.                    ExpandString = ""
    
77.                    Exit Function
    
78.          End If
    
79.          
    
80.          width0 = Len(appointedStr)
    
81.          repeat_times = appointedwidth \ width0
    
82.          reminder = appointedwidth Mod width0         
    
83.          
    
84.          For i = 1 To repeat_times
    
85.                    result = result & appointedStr
    
86.          Next
    
87.          
    
88.          result = result & Left(appointedStr, reminder)
    
89.          ExpandString = result
    
90. End Function
    
91. 
    

复制代码

lyscser

简而言之就是重新封装一个函数，或者你自己去重载一个同名函数也行

qdd6501

回复 5# lyscser

可是我要加载的那个excel里只有一个sheet表啊

lyscser

用同样的办法，干吗不先试试？

qdd6501

回复 7# lyscser
下面是我用你的方法试的代码，运行结果是原excel里的内容已经考到了同个目录下的名为test的excel里了，然后qtp 的datatable里也多了个aSheet 的datatable，但是最后test里的数据还是没有到aSheet里面去。

strDatafile = glbPREEXEC & "Exposure Report_0104release_6.xls"
Dim excelApp
Set ExcelApp = CreateObject("Excel.Application")

ExcelApp.Application.Visible = False

ExcelApp.DisplayAlerts = False
Dim newBook
Set newBook = ExcelApp.Workbooks.Open (strDatafile,False,True)

newBook.Worksheets("Sheet1").Copy
Dim tempBook
Set tempBook = ExcelApp.ActiveWorkbook

tempBook.SaveAs glbPREEXEC &"test",1

Set tempBook = Nothing

ExcelApp.Quit

Set ExcelApp = Nothing

DataTable.AddSheet "aSheet"

DataTable.ImportSheet  glbPREEXEC &"test","Sheet1","aSheet"

qdd6501

DataTable.ImportSheet  glbPREEXEC &"test","Sheet1","aSheet"这句有问题
我改成DataTable.ImportSheet  glbPREEXEC &"test.xls","Sheet1","aSheet" 然后再运行到这一句的时候qtp就死掉了，没反应了。