Board logo

标题: [问题求助] 求修改一段vbs代码:实现批量将多个xls表格转csv [打印本页]
作者: sxsxiao    时间: 2013-5-4 10:49     标题: 求修改一段vbs代码:实现批量将多个xls表格转csv

本帖最后由 pcl_test 于 2016-7-31 21:51 编辑

下面的代码是xls转csv的,求修改成点击一下VBS一个步骤完成:把文件夹下面的所有xls，按原来的前缀文件名转成csv
  1. Const xlCSV = 6

  2. 

  3. dim filepathname

  4. Set objExcel = CreateObject("Excel.Application")

  5. Filename = objExcel.GetOpenFilename("Excel Files (*.xls), *.xls") 

  6. objExcel.DisplayAlerts=FALSE

  7. If filename<>false Then

  8. 	On Error Resume Next

  9. 	Set objWorkbook = objExcel.Workbooks.Open(Filename)

  10. 	If Err.Number <> 0 Then

  11. 		Err.Raise Err.Number

  12. 		Return "-1"

  13. 	End If

  14. 	objWorkbook.SaveAs mid(Filename,1,len(Filename)-4) & ".csv",xlCSV

  15. 	If Err.Number <> 0 Then

  16. 		Err.Raise Err.Number

  17. 		Return "-1"

  18. 	End If

  19. 	'MsgBox objWorkbook.path

  20. 	filepathname = objWorkbook.path & "\\" & mid(Filename,1,len(Filename)-4) & ".csv"

  21. 	objWorkbook.close

  22. End If

  23. objExcel.Quit

  24. 'MsgBox filepathname

  25. If filepathname>"" then 

  26. 	Return filepathname

  27. end if
复制代码
作者: czjt1234    时间: 2013-5-4 15:24

  1. Set objFSO = CreateObject("Scripting.FileSystemObject")

  2. Set objExcel = CreateObject("Excel.Application")

  3. objExcel.DisplayAlerts = False

  4. 

  5. strFolder = CreateObject("Wscript.Shell").CurrentDirectory & "\"

  6. 

  7. Set objFiles = objFSO.GetFolder(strFolder).Files

  8. For Each objFile In objFiles

  9.     If Lcase(Split(objFile.Name, ".")(1)) = "xls" Then

  10.         Set objWorkbook = objExcel.Workbooks.Open(strFolder & objFile.Name)

  11.         objWorkbook.SaveAs strFolder & Split(objFile.Name, ".")(0) & ".csv", 6

  12.         objWorkbook.Close

  13.     End If

  14. Next

  15. 

  16. objExcel.Quit
复制代码
作者: sxsxiao    时间: 2013-5-4 20:14

谢谢啊，好用



欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2