[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[问题求助] 求修改一段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
复制代码

谢谢啊,好用

TOP

  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
复制代码
1

评分人数

    • sxsxiao: 谢谢啊,代码很好用技术 + 1

QQ 20147578

TOP

返回列表