Board logo

标题: [原创] xls2csv VBS脚本 [打印本页]

作者: wsk170    时间: 2015-8-21 11:28     标题: xls2csv VBS脚本

借鉴了批处理之家帖子中的一些代码,在此表示感谢。
  1. ' xls2csv.vbs
  2. ' wsk170@gmail.com
  3. ' 2015/8/21
  4.    
  5. On Error Resume Next
  6. Set objArgs = WScript.Arguments
  7. Set argsNamed = WScript.Arguments.Named
  8. Set argsUnnamed = WScript.Arguments.Unnamed
  9. If objArgs.Count = 0 Then Usage()
  10. If argsNamed.Count = 0 Then
  11.     strFileOrFolder = objArgs(0)
  12. ElseIf argsNamed.Count = 1 Then
  13.     If objArgs(0) = "/a" Then
  14.         If objArgs.Count = 2 Then
  15.             strFileOrFolder = objArgs(1)
  16.         Else
  17.             Usage()
  18.         End If
  19.     ElseIf objArgs(0) = "/i" Then
  20.         If objArgs.Count > 2 Then
  21.             strFileOrFolder = objArgs(1)
  22.         Else
  23.             Usage()
  24.         End If
  25.     Else
  26.         Usage()
  27.     End If   
  28. Else
  29.     Usage()
  30. End If
  31. Set objFSO = CreateObject("Scripting.FileSystemObject")
  32. Set objExcel = Excel_Init()
  33. If objFSO.FolderExists(strFileOrFolder) Then
  34.     Set objFiles = objFSO.GetFolder(strFileOrFolder).Files
  35.     strFolder = objFSO.GetAbsolutePathName(strFileOrFolder)
  36.     For Each objFile In objFiles
  37.         SaveAsCSV objFile
  38.     Next
  39. ElseIf objFSO.FileExists(strFileOrFolder) Then
  40.     Set objFile = objFSO.GetFile(strFileOrFolder)
  41.     strFolder = objFile.ParentFolder
  42.     SaveAsCSV objFile
  43. Else
  44.     WScript.Echo strFileOrFolder & "  不存在!"
  45. End If
  46. objExcel.Quit
  47. WScript.Quit
  48. Sub Usage()
  49.     Msgbox "使用方法:  " & WScript.ScriptName & " [/a|/i] [文件|目录] [参数1] [参数2] [参数n] ..." & vbCr & _
  50.         vbCr & "csv文件将保存在 [文件|目录] 所在的目录下。" & vbCr & _
  51.         vbCr & "示例" & vbCr & _
  52.         "xls2csv.vbs  工作簿1.xls" & vbCr & _
  53.         "  将工作簿1.xls中的活动工作表另存为csv文件。" & vbCr & _
  54.         "xls2csv.vbs  工作簿1.xls  Sheet1 Sheet2 " & vbCr & _
  55.         "  将工作簿1.xls中的Sheet1、Sheet2 两个工作表分别另存为csv文件。" & vbCr & _
  56.         "xls2csv.vbs  /a  工作簿1.xls" & vbCr & _
  57.         "  将工作簿1.xls中所有的工作表分别另存为csv文件。" & vbCr & _
  58.         "xls2csv.vbs  /i  工作簿1.xls 1,3 6,9 12" & vbCr & _
  59.         "  将工作簿1.xls中索引编号为1~3、6~9、12的工作表分别另存为csv文件。" & vbCr & _
  60.         "xls2csv.vbs 目录1" & vbCr & _
  61.         "  将目录1中每个xls或xlsx文件的活动工作表分别另存为csv文件。", vbOKOnly, WScript.ScriptName
  62.     WScript.Quit
  63. End Sub
  64. Function Excel_Init()
  65.   On Error Resume Next
  66.   Set objExcel = CreateObject("Excel.Application")
  67.   If Not Err.Number = 0 Then
  68.     WScript.Echo "错误:无法创建 Excel 对象,你可能没有安装 Excel 。"
  69.     WScript.Quit
  70.   End If
  71.   ' 隐藏运行,屏蔽提示
  72.   objExcel.Visible = False
  73.   objExcel.DisplayAlerts = False
  74.   Set Excel_Init = objExcel
  75. End Function
  76. Sub SaveAsCSV(objFile)
  77.     strBaseName = objFSO.GetBaseName(objFile.Name)
  78.     strExtName = LCase(objFSO.GetExtensionName(objFile.Name))
  79.     If strExtName <> "xls" And strExtName <> "xlsx" Then Exit Sub
  80.     Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
  81.    
  82.     ' 如果只有一个参数,则默认另存为工作簿的活动工作表
  83.     If argsNamed.Count = 0 And objArgs.Count = 1 Then
  84.         objWorkbook.SaveAs strFolder & "\" & strBaseName & ".csv", 6
  85.         objWorkbook.Close
  86.         Exit Sub
  87.     End If
  88.    
  89.     ' 如果有多个参数,则另存为工作簿中指定名字的工作表
  90.     If argsNamed.Count = 0 And objArgs.Count > 1 Then
  91.         For i = 1 To objArgs.Count - 1
  92.             For Each Sheet In objWorkbook.Worksheets
  93.                 If objArgs(i) = Sheet.Name Then
  94.                     Sheet.SaveAs strFolder & "\" & strBaseName & "_" & Sheet.Name & ".csv", 6
  95.                     Exit For
  96.                 End If
  97.             Next
  98.         Next
  99.         objWorkbook.Close
  100.         Exit Sub
  101.     End If
  102.    
  103.     ' 如果有/a选项,则另存为工作簿的所有工作表
  104.     If argsNamed.Count = 1 And objArgs(0) = "/a" Then
  105.         For Each Sheet In objWorkbook.Worksheets
  106.             Sheet.SaveAs strFolder & "\" & strBaseName & "_" & Sheet.Name & ".csv", 6
  107.         Next
  108.         objWorkbook.Close
  109.         Exit Sub
  110.     End If
  111.    
  112.     ' 如果有/i选项,则另存为工作簿中指定索引编号范围内的工作表
  113.     ' 需检查参数是否为数字,忽略非数字参数
  114.     If argsNamed.Count = 1 And objArgs(0) = "/i" Then
  115.         For i = 2 To objArgs.Count - 1
  116.             arrIndex = Split(objArgs(i), ",")
  117.             If IsNumeric(arrIndex(0)) And IsNumeric(arrIndex(UBound(arrIndex))) Then
  118.                 For j = arrIndex(0) To arrIndex(UBound(arrIndex))
  119.                     For Each Sheet In objWorkbook.Worksheets
  120.                         If j = Sheet.Index Then
  121.                             Sheet.SaveAs strFolder & "\" & strBaseName & "_" & Sheet.Index & "_" & Sheet.Name & ".csv", 6
  122.                             Exit For
  123.                         End If
  124.                     Next
  125.                 Next
  126.             End If
  127.         Next
  128.     End If
  129.    
  130. End Sub
复制代码

作者: zhangop9    时间: 2015-9-25 08:52

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




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2