|
最近用QTP导入EXCEL文件的时候常遇到excel文件无法导入的问题.
找了很久论坛也问过了,都没有根本解决,一天突发奇想既然excel文件导入不了,那么QTP导出来的excel文件总应该可以使用吧
于是写脚本,直接从excel文件中取出数据,写入DataTable然后从DataTable中导出成excel文件.就可以使用Import导入了.
代码如下其实代码不复杂,关键是要有解决思路)
'***********************************************************
'功能说明:把无法正确导入到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 |
|