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. dim filepathname
  3. Set objExcel = CreateObject("Excel.Application")
  4. Filename = objExcel.GetOpenFilename("Excel Files (*.xls), *.xls")
  5. objExcel.DisplayAlerts=FALSE
  6. If filename<>false Then
  7. On Error Resume Next
  8. Set objWorkbook = objExcel.Workbooks.Open(Filename)
  9. If Err.Number <> 0 Then
  10. Err.Raise Err.Number
  11. Return "-1"
  12. End If
  13. objWorkbook.SaveAs mid(Filename,1,len(Filename)-4) & ".csv",xlCSV
  14. If Err.Number <> 0 Then
  15. Err.Raise Err.Number
  16. Return "-1"
  17. End If
  18. 'MsgBox objWorkbook.path
  19. filepathname = objWorkbook.path & "\\" & mid(Filename,1,len(Filename)-4) & ".csv"
  20. objWorkbook.close
  21. End If
  22. objExcel.Quit
  23. 'MsgBox filepathname
  24. If filepathname>"" then
  25. Return filepathname
  26. 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. strFolder = CreateObject("Wscript.Shell").CurrentDirectory & "\"
  5. Set objFiles = objFSO.GetFolder(strFolder).Files
  6. For Each objFile In objFiles
  7.     If Lcase(Split(objFile.Name, ".")(1)) = "xls" Then
  8.         Set objWorkbook = objExcel.Workbooks.Open(strFolder & objFile.Name)
  9.         objWorkbook.SaveAs strFolder & Split(objFile.Name, ".")(0) & ".csv", 6
  10.         objWorkbook.Close
  11.     End If
  12. Next
  13. objExcel.Quit
复制代码

作者: sxsxiao    时间: 2013-5-4 20:14

谢谢啊,好用




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