xls2csv VBS脚本
借鉴了批处理之家帖子中的一些代码,在此表示感谢。[code]' xls2csv.vbs' wsk170@gmail.com
' 2015/8/21
On Error Resume Next
Set objArgs = WScript.Arguments
Set argsNamed = WScript.Arguments.Named
Set argsUnnamed = WScript.Arguments.Unnamed
If objArgs.Count = 0 Then Usage()
If argsNamed.Count = 0 Then
strFileOrFolder = objArgs(0)
ElseIf argsNamed.Count = 1 Then
If objArgs(0) = "/a" Then
If objArgs.Count = 2 Then
strFileOrFolder = objArgs(1)
Else
Usage()
End If
ElseIf objArgs(0) = "/i" Then
If objArgs.Count > 2 Then
strFileOrFolder = objArgs(1)
Else
Usage()
End If
Else
Usage()
End If
Else
Usage()
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = Excel_Init()
If objFSO.FolderExists(strFileOrFolder) Then
Set objFiles = objFSO.GetFolder(strFileOrFolder).Files
strFolder = objFSO.GetAbsolutePathName(strFileOrFolder)
For Each objFile In objFiles
SaveAsCSV objFile
Next
ElseIf objFSO.FileExists(strFileOrFolder) Then
Set objFile = objFSO.GetFile(strFileOrFolder)
strFolder = objFile.ParentFolder
SaveAsCSV objFile
Else
WScript.Echo strFileOrFolder & " 不存在!"
End If
objExcel.Quit
WScript.Quit
Sub Usage()
Msgbox "使用方法: " & WScript.ScriptName & " [/a|/i] [文件|目录] [参数1] [参数2] [参数n] ..." & vbCr & _
vbCr & "csv文件将保存在 [文件|目录] 所在的目录下。" & vbCr & _
vbCr & "示例" & vbCr & _
"xls2csv.vbs 工作簿1.xls" & vbCr & _
" 将工作簿1.xls中的活动工作表另存为csv文件。" & vbCr & _
"xls2csv.vbs 工作簿1.xls Sheet1 Sheet2 " & vbCr & _
" 将工作簿1.xls中的Sheet1、Sheet2 两个工作表分别另存为csv文件。" & vbCr & _
"xls2csv.vbs /a 工作簿1.xls" & vbCr & _
" 将工作簿1.xls中所有的工作表分别另存为csv文件。" & vbCr & _
"xls2csv.vbs /i 工作簿1.xls 1,3 6,9 12" & vbCr & _
" 将工作簿1.xls中索引编号为1~3、6~9、12的工作表分别另存为csv文件。" & vbCr & _
"xls2csv.vbs 目录1" & vbCr & _
" 将目录1中每个xls或xlsx文件的活动工作表分别另存为csv文件。", vbOKOnly, WScript.ScriptName
WScript.Quit
End Sub
Function Excel_Init()
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Not Err.Number = 0 Then
WScript.Echo "错误:无法创建 Excel 对象,你可能没有安装 Excel 。"
WScript.Quit
End If
' 隐藏运行,屏蔽提示
objExcel.Visible = False
objExcel.DisplayAlerts = False
Set Excel_Init = objExcel
End Function
Sub SaveAsCSV(objFile)
strBaseName = objFSO.GetBaseName(objFile.Name)
strExtName = LCase(objFSO.GetExtensionName(objFile.Name))
If strExtName <> "xls" And strExtName <> "xlsx" Then Exit Sub
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
' 如果只有一个参数,则默认另存为工作簿的活动工作表
If argsNamed.Count = 0 And objArgs.Count = 1 Then
objWorkbook.SaveAs strFolder & "\" & strBaseName & ".csv", 6
objWorkbook.Close
Exit Sub
End If
' 如果有多个参数,则另存为工作簿中指定名字的工作表
If argsNamed.Count = 0 And objArgs.Count > 1 Then
For i = 1 To objArgs.Count - 1
For Each Sheet In objWorkbook.Worksheets
If objArgs(i) = Sheet.Name Then
Sheet.SaveAs strFolder & "\" & strBaseName & "_" & Sheet.Name & ".csv", 6
Exit For
End If
Next
Next
objWorkbook.Close
Exit Sub
End If
' 如果有/a选项,则另存为工作簿的所有工作表
If argsNamed.Count = 1 And objArgs(0) = "/a" Then
For Each Sheet In objWorkbook.Worksheets
Sheet.SaveAs strFolder & "\" & strBaseName & "_" & Sheet.Name & ".csv", 6
Next
objWorkbook.Close
Exit Sub
End If
' 如果有/i选项,则另存为工作簿中指定索引编号范围内的工作表
' 需检查参数是否为数字,忽略非数字参数
If argsNamed.Count = 1 And objArgs(0) = "/i" Then
For i = 2 To objArgs.Count - 1
arrIndex = Split(objArgs(i), ",")
If IsNumeric(arrIndex(0)) And IsNumeric(arrIndex(UBound(arrIndex))) Then
For j = arrIndex(0) To arrIndex(UBound(arrIndex))
For Each Sheet In objWorkbook.Worksheets
If j = Sheet.Index Then
Sheet.SaveAs strFolder & "\" & strBaseName & "_" & Sheet.Index & "_" & Sheet.Name & ".csv", 6
Exit For
End If
Next
Next
End If
Next
End If
End Sub
[/code] 有用的只有一句,可是写的真好
页:
[1]