求修改一段vbs代码:实现批量将多个xls表格转csv

sxsxiao

下面的代码是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

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

谢谢啊，好用