'***********************************************************
'功能说明:把无法正确导入到QTP中的excel文件,转换为可以导入到QTP中的excel文件
'脚本说明:excel文件中,第一行,是用来判断是否需要转换的,所以如果第一行没有内容,将自动停止转换.
'excel中任何一列中间掺杂空白表格,将从此空白表格处停止转换下方的内容.
'输出文件和源文件一个目录
'脚本必须设置只运行一次.
'***********************************************************
Dim row,row2
row=2 '设置开始转换的行
row2=1 '设置开始转换的列
tablename=""
workbookurl=Select_File("D:\")
If workbookurl="" Then
msgbox("没有选择文件.程序将退出")
else
Set ExcelObj = CreateObject("Excel.Application") ' 创建excle工作表对象
ExcelObj.Visible = False '不显示打开的excel窗体
Set xlsWorkBook = ExcelObj.Workbooks.Open(workbookurl) '打开excle文件
Set NewSheet = xlsWorkBook.Sheets(1) '选择添加数据的工作表
Do '列循环开始
If NewSheet.Cells(1,row2) = "" then'如果纵单元格第一行没有内容,就说明不需要转换了.
Exit do
else
tablename=NewSheet.Cells(1,row2)
tablename=DataTable.GetSheet("Global").AddParameter(tablename,"").Name '新建导入数据的字段名称.并赋值内容""
end if
row=2 '初始化行
Do '行循环开始
tmp=NewSheet.Cells(row,row2)
If tmp = "" then'如果列中某单元格为空,则进入下一列开始转换
Exit do
end if
datatable.GlobalSheet.GetParameter(tablename).ValueByRow(row-1)=tmp'写入数据到datatable中
row=row+1
loop
row2=row2+1
loop
xlsWorkBook.close '关闭工作表
Set xlsWorkBook = Nothing
datatable.Export(workbookurl&"-转换后的.xls")
msgbox("转换完成")
End If
'选择文件函数
Function Select_File(From_FilePath)
If From_FilePath ="" Then
From_FilePath="C:\"
End If
Set bjDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Excel文件|*.xls"
objDialog.InitialDir = From_FilePath
intResult = objDialog.ShowOpen
Select_File=objDialog.FileName
End Function作者: Jun_Li 时间: 2009-7-2 09:19
why can't import data ? Whether there are performance issues? ths作者: onlonely 时间: 2009-7-2 14:18 标题: 回复 2# 的帖子 是由于excel中可能包含了,QTP不允许存在的格式.
一般少量数据的EXCEL文件是不会这样的.
当excel文件中数据量很大的时候,就很有可能无法用import 导入..作者: 小_麦 时间: 2009-7-2 15:00
请教LZ你有没有找到过非法格式的规律???我一直都很头疼这个问题,困扰我很久.我用到了大量的Excel,但经常莫名其妙的导入不成功,尤其存在多个Sheet的时候更难定位到出错的位置,我也曾经试过类似你这种方法,但是效果不理想,很费时
其实代码不复杂,关键是要有解决思路)