萧萧的枫林，萧萧的我
QTP中Excel文件无法导入问题的解决办法
上一篇 /
下一篇 2009-07-02 08:31:19
/ 个人分类：QTP
最近用QTP导入EXCEL文件的时候常遇到excel文件无法导入的问题.
找了很久论坛也问过了,都没有根本解决,一天突发奇想既然excel文件导入不了,那么QTP导出来的excel文件总应该可以使用吧
于是写脚本,直接从excel文件中取出数据,写入DataTable然后从DataTable中导出成excel文件.就可以使用Import导入了.
代码如下:(其实代码不复杂,关键是要有解决理路)
''***********************************************************
'功能说明:把无法正确导入到QTP中的excel文件,转换为可以导入到QTP中的excel文件
'脚本说明:excel文件中,如果第一行的某列没有内容,将自动停止转换.
'excel中任何一列中间掺杂空白表格,将从此空白表格处停止转换下方的内容.
'输出文件和源文件在同一个目录
'脚本必须放在QTP中执行
'***********************************************************
Dim row,row2
row=2 '设置开始转换的行
row2=1 '设置开始转换的列
tablename=""
workbookurl=Select_File("D:\")
If workbookurl="" Then
msgbox("没有选择文件.程序将退出")
exitrun
end if
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("转换完成")
'选择文件函数
Function Select_File(From_FilePath)
If not existed(From_FilePath,"^[A-Za-z]:.*") 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
'正则表达式函数
Public Function Existed(Exist_String,Reg_Pattern)
Dim re
Set re = New RegExp
re.Pattern = Reg_Pattern
re.IgnoreCase=True
Existed=re.test(Exist_String)
Set re=Nothing
end Function
'结束脚本
ExitRun
收藏
举报
TAG:
