使用 VBScript 将 xls / xlsx 文件(所有工作表)转换为 csv(以分号分隔)

2024-01-01

我需要将包含所有工作表的 Excel 文件(*.xls 、 *.xlsx)转换为按工作表拆分的 CSV 文件。 输出 CSV 文件应以 SheetName 命名,并以分号(而不是逗号)分隔。 我已经通过将多个 VBS 脚本绑定到一个中来完成此操作,但仍然存在错误。 我下面的代码对 XLS 文件中以分号分隔、由工作表命名的所有工作表进行转换 - 但一个小错误是,如果有多个工作表,则下一个工作表的内容将被第一个工作表覆盖。 请问有什么问题吗?我在 cmd 中运行它:xls_to_csv.vbs ExcelFile.xls OutPutdir

'------------------- SET SEMI-COLON DELIMITER VIA WIN REGISTERS ---------------
strDelimiter = ";"

strSystemDelimiter = ""           ' This will be used to store the current sytem value
Const HKEY_CURRENT_USER = &H80000001

' Get the current List Separator (Regional Settings) from the registry
strKeyPath = "Control Panel\International"
strValueName = "sList"
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
objRegistry.GetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strSystemDelimiter

' Set it temporarily to our custom delimiter
objRegistry.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strDelimiter


'----------------------------- CONVERT XLS TO CSV ------------------------------
Dim strExcelFileName
Dim strCSVFileName
Dim objFSO
Set objFSO = CreateObject("scripting.filesystemobject")  
strPath = objFSO.GetAbsolutePathName(Wscript.Arguments.Item(1))

strExcelFileName = WScript.Arguments.Item(0)  'file name to parses

rem get path where script is running
Set fso = CreateObject ("Scripting.FileSystemObject")  'use this to find current path
strScript = Wscript.ScriptFullName
strScriptPath = fso.GetAbsolutePathName(strScript & "\..")

rem If the Input file is NOT qualified with a path, default the current path
LPosition = InStrRev(strExcelFileName, "\")
if LPosition = 0 Then 'no folder path
strExcelFileName = strScriptPath & "\" & strExcelFileName
strScriptPath = strScriptPath & "\"
else                 'there is a folder path, use it for the output folder path also
strScriptPath = Mid(strExcelFileName, 1, LPosition)
End If
rem msgbox LPosition & " - " & strExcelFileName & " - " & strScriptPath  ' use this for debugging

Dim objXL
Dim objWorkBook, local
Set objXL = CreateObject("Excel.Application")
Set objWorkBook = objXL.Workbooks.Open(strExcelFileName)

objXL.DisplayAlerts = False
rem loop over worksheets
  For Each sheet In objWorkBook.Sheets 
      'only saveAS sheets that are NOT empty
if objXL.Application.WorksheetFunction.CountA(sheet.Cells) <> 0 Then
rem             sheet.Rows(1).delete  ' this will remove Row 1 or the header Row
local = true  
call objWorkBook.SaveAs(strPath & "\" & sheet.Name & ".csv", 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, local)
    End If
  Next

rem clean up 
objWorkBook.Close
objXL.quit
Set objXL = Nothing
Set objWorkBook = Nothing
Set fso = Nothing

'------------------------- RETURN REGISTRY CHANGES BACK --------------------
' Reset the system setting to its original value
objRegistry.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strSystemDelimiter

rem end script    

您正在尝试保存 WorkSheet,但正在使用 WorkBook 对象。尝试使用通过 For 语句提取的 WorkSheet 对象

 Dim WorkSheet
 For Each WorkSheet In objWorkBook.Sheets 
  If objXL.Application.WorksheetFunction.CountA(WorkSheet.Cells) <> 0 Then
   WorkSheet.SaveAs strPath & "\" & WorkSheet.Name & ".csv", 6
  End If
 Next

这对我有用。

我已将您的“工作表”更改为“工作表”只是为了强调差异。当然,“sheet”或任何其他对象名称都可以正常工作。

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

使用 VBScript 将 xls / xlsx 文件(所有工作表)转换为 csv(以分号分隔) 的相关文章

随机推荐