用QTP去加载Excel到Global的Datatable
用QTP去加载Excel到Global的Datatable里去的时候一般的excel能加载进来，可是有些excel却加载进来了Global表里却没有看到数据，或者加载的时候会报错，然后qtp就死掉了，必须关掉进程才行。也不是这个excel太大的缘故，不知道是怎么回事了？ 代码是这样的：strDatafile = glbPREEXEC & "Exposure Report_0104release_6.xls"’这个路径取的是对的
strSheetName = 1
DataTable.ImportSheet strDataFile,1,1
DataTable.GetSheet(1) 本帖最后由 lyscser 于 2011-2-21 12:14 编辑
是EXCEL的Sheet过多导致的，这个问题比较常见，解决方法如下：
'************************************************************************
'设计说明： 用于将EXCEL中某个SHEET单独COPY出来到一个临时的文件中，从临时文件导入DATATABLE，避免SHEET过多导致的EXCEL出错
'程序输入：
'1. appointedFile -- 原EXCEL
'2. appointedSheet -- 原EXCEL的SHEET
'3. newSheet -- 新的EXCEL临时SHEET
'程序输出： 将指定路径下的指定EXCEL的指定SHEET导入DataTable
'设计人员： 刘毅（LIUYI）
'设计时间： 2008-11-05
'调用举例： impXls "D:\test.xls","原始SHEET","新的SHEET"
'************************************************************************
Public Function impXls(appointedFile,appointedSheet,newSheet)
On Error Resume Next
Dim tmpName:tmpName = Environment.Value("SystemTempDir") & "\" & GenerateUniqueStr(30) & ".xls"
Dim bolVal:bolVal = False
Set fObject = CreateObject("Scripting.FileSystemObject")
IfNot fObject.FileExists(appointedFile) Then
Repor micFail,"参数文件不存在：",appointedFile
Set fObject = Nothing
Exit Function
End If
If fObject.FileExists(tmpName) Then
fObject.DeleteFile(tmpName)
End If
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Application.Visible = False
ExcelApp.DisplayAlerts = False
Set newBook = ExcelApp.Workbooks.Open (appointedFile,False,True)
newBook.Worksheets(appointedSheet).Copy
Set tempBook = ExcelApp.ActiveWorkbook
tempBook.SaveAs tmpName,1
Set tempBook = Nothing
ExcelApp.Quit
Set ExcelApp = Nothing
DataTable.AddSheet newSheet
DataTable.ImportSheet tmpName,appointedSheet,newSheet
IffObject.FileExists(tmpName) Then
fObject.DeleteFile(tmpName)
End If
bolVal = ErrorHandle()
IfbolVal Then
Reporter ReportEvent micPass,"impXls导入参数成功：","文件【" & appointedFile & "】的【" & appointedSheet & "】页已经导入到【" & newSheet & "】"
End If
Set fObject = Nothing
impXls = bolVal
End Function
补充被调用函数一组：
'************************************************************************
'设计说明： 根据日期、时间和两组随机数生成相对较为唯一的字符串，常用于文件的非覆盖保存'程序输入：
' 1. circleNumber -- 循环次数
'程序输出： 日期、时间、随机数、随机数的拼接字符串如：20110107_161003_93778_47149
'设计人员： 刘毅（LIUYI）
'设计时间： 2011-01-07
'调用举例： Printer GenerateUniqueStr("30")
'************************************************************************
Public Function GenerateUniqueStr(circleNumber)
If Trim(circleNumber) = "" Then
circleNumber = randomnumber.Value(20,50)
Else
If circleNumber < 11 Then
circleNumber = circleNumber + 20
End If
End If
randomNo = randomnumber.Value(10,Abs(circleNumber))
For i = 1 to randomNo
randomNum1 = randomnumber.Value(10000,99999)
randomNum2 = Int((99999-10000+1)*rnd+10000)
Next
GenerateUniqueStr = FormatDate(Now,"yyyymmdd_hh24miss")&"_"&randomNum1&"_"&randomNum2
End Function
'******************************************************************************
'设计说明： （模仿PL/SQL同名函数）将字符串扩展到指定长度，用fillWithChar从左边循环填充，本函数不会截短appointedStr
'程序输入：
' 1. appointedStr -- 字符串
' 2. appointedwidth -- 指定的长度
' 3. fillWithChar -- 填充字符
'程序输出：
'设计人员： 刘毅（LIUYI）
'设计时间： 2011-01-04
'调用举例： msgbox OracleLPadStr(Second(theTime), 2, "0")
'******************************************************************************
Function OracleLPadStr(appointedStr, appointedwidth, fillWithChar)
OracleLPadStr = ExpandString(fillWithChar, appointedwidth - Len(appointedStr)) & appointedStr
End Function
'******************************************************************************
'设计说明： （模仿PL/SQL同名函数）将字符串扩展到指定长度，用fillWithChar从左边循环填充，本函数不会截短appointedStr
'程序输入：
' 1. appointedStr -- 字符串
' 2. appointedwidth -- 指定的长度
' 3. fillWithChar -- 填充字符
'程序输出：
'设计人员： 刘毅（LIUYI）
'设计时间： 2011-01-04
'调用举例： msgbox OracleLPadStr(Second(theTime), 2, "0")
'******************************************************************************
Function OracleRPadStr(appointedStr, appointedwidth, fillWithChar)
OracleRPadStr = appointedStr & ExpandString(fillWithChar, appointedwidth - Len(appointedStr))
End Function
'******************************************************************************
'设计说明： 将appointedStr反复叠加，使其长度扩展（或缩小）到appointedwidth
'程序输入：
' 1. appointedStr -- 字符串
' 2. appointedwidth -- 指定的长度
'程序输出：
'设计人员： 刘毅（LIUYI）
'设计时间： 2011-01-04
'调用举例： ExpandString("bye",7) 返回 byebyeb ； ExpandString("bye",2)返回 by
'******************************************************************************
Private Function ExpandString(appointedStr, appointedwidth)
Dim width0, repeat_times, reminder, i, result
If appointedwidth <= 0 Then
ExpandString = ""
Exit Function
End If
width0 = Len(appointedStr)
repeat_times = appointedwidth \ width0
reminder = appointedwidth Mod width0
For i = 1 To repeat_times
result = result & appointedStr
Next
result = result & Left(appointedStr, reminder)
ExpandString = result
End Function
简而言之就是重新封装一个函数，或者你自己去重载一个同名函数也行 回复 5# lyscser
可是我要加载的那个excel里只有一个sheet表啊 用同样的办法，干吗不先试试？ 回复 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.ImportSheetglbPREEXEC &"test","Sheet1","aSheet" DataTable.ImportSheetglbPREEXEC &"test","Sheet1","aSheet"这句有问题
我改成DataTable.ImportSheetglbPREEXEC &"test.xls","Sheet1","aSheet" 然后再运行到这一句的时候qtp就死掉了，没反应了。
页:
[1]
