[原创] xls2csv VBS脚本

wsk170

借鉴了批处理之家帖子中的一些代码，在此表示感谢。

' 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 SubCOPY

zhangop9

有用的只有一句，可是写的真好