vbs递归处理excel文件

上一篇 / 下一篇  2013-01-05 11:12:43 / 个人分类:QTP学习记录

在Win7+QTP10的环境中编写的脚本,放到2003+QTP10的环境中运行时,会提示default.xls文件打不开,后来发现将Excel文件打开另存为到当前目录下即可。为节约时间,编写出下面的vbs脚本解决此问题。
Dim input
input = InPutBox("请输入文件路径:","excelSaveAs")
If input = "" Then
Call MsgBox("文件路径不能为空",0,"excekSaveAs")
input = InPutBox("请输入文件路径:","excelSaveAs")
End If
Call findFile(input,"xls")
Call MsgBox("Excel文件处理完成。",0,"excelSaveAs")
'递归查找指定目录下所有文件夹中的指定的文件
'传入参数:searchFolder  -----要搜索的目录
'传入参数:fileType      -----要搜索的文件类型,例如xls、doc等
'参    数:fso----------------FileSystemObject对象
'参    数:objFile------------检索到的文件
'参    数:objFC--------------文件夹下检索到的文件集合
'参    数:objFolder----------标记为文件夹
'参    数:subFolderC---------子文件夹下检索到的子文件夹集合  
'参    数:subFolder----------子文件夹
'参    数:searchedFilePath---文件的路径
Function findFile(searchFolder,fileType)
Dim fso,objFile,objFC,objFolder,subFolderC,subFolder,searchedFilePath
Dim fileNum
fileNum=0
Set fso = CreateObject("Scripting.FileSystemObject")
Set bjFolder = fso.GetFolder(searchFolder)
Set bjFC = objFolder.Files
nums = objFC.Count
For Each objFile in objFC
filet = Right(objFile.Name,3)
If filet = fileType Then
fileNum = fileNum+1
Call saveAsExcel(objFile.Path)
End If
nums = nums-1
If nums =0 Then
Exit For
End If
Next
'递归查找子目录
Set subFolderC = objFolder.SubFolders
For Each subFolder in subFolderC
Call findFile(subFolder,fileType)
Next
'释放内存
Set fso = Nothing
Set bjFolder = Nothing
Set bjFC = Nothing
Set bjFile = Nothing
Set subFolderC = Nothing
Set subFolder = Nothing
End Function

Function saveAsExcel(filePath)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Set xlsApp = CreateObject("Excel.Application") '创建Excel对象
xlsApp.Visible = True 'true 为显示excel对象,false为不显示
Set xlsWorkBook = xlsApp.Workbooks.Open (filePath) '打开指定路径的Excel表格,filename包含路径名
xlsWorkBook.SaveAs(filePath& "1")
fso.DeleteFile(filePath)
xlsWorkBook.SaveAs(filePath)
fso.DeleteFile(filePath& "1")
xlsWorkBook.Close
xlsApp.Quit
Set xlsWorkBook = Nothing '释放内存
Set xlsApp = Nothing '释放内存
Set f = Nothing
Set fso = Nothing
End Function

TAG:

 

评分:0

我来说两句

Open Toolbar