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

sxsxiao

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

Const xlCSV = 6

dim filepathname
Set objExcel = CreateObject("Excel.Application")
Filename = objExcel.GetOpenFilename("Excel Files (*.xls), *.xls") 
objExcel.DisplayAlerts=FALSE
If filename<>false Then
	On Error Resume Next
	Set objWorkbook = objExcel.Workbooks.Open(Filename)
	If Err.Number <> 0 Then
		Err.Raise Err.Number
		Return "-1"
	End If
	objWorkbook.SaveAs mid(Filename,1,len(Filename)-4) & ".csv",xlCSV
	If Err.Number <> 0 Then
		Err.Raise Err.Number
		Return "-1"
	End If
	'MsgBox objWorkbook.path
	filepathname = objWorkbook.path & "\\" & mid(Filename,1,len(Filename)-4) & ".csv"
	objWorkbook.close
End If
objExcel.Quit
'MsgBox filepathname
If filepathname>"" then 
	Return filepathname
end if
复制代码

czjt1234

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False

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

Set objFiles = objFSO.GetFolder(strFolder).Files
For Each objFile In objFiles
    If Lcase(Split(objFile.Name, ".")(1)) = "xls" Then
        Set objWorkbook = objExcel.Workbooks.Open(strFolder & objFile.Name)
        objWorkbook.SaveAs strFolder & Split(objFile.Name, ".")(0) & ".csv", 6
        objWorkbook.Close
    End If
Next

objExcel.Quit
复制代码

sxsxiao

谢谢啊，好用