使用VBScript将xls转换为csv并以分号分隔

时间:2012-02-09 18:50:46

标签: csv vbscript xls xlsx

我有一个VBScript代码片段,可将我的xls和xlsx文件转换为csv文件。但是,我希望每个单元格用分号而不是逗号分隔。在我的计算机上,列表分隔符设置为分号而不是逗号,所以当我打开一个excel窗口并保存为csv时,它会以分号分隔。但是,我的VBScript生成一个用逗号分隔的csv文件。我在网上找到了代码片段,因为我不太了解VBScript(我主要是Java程序员)。如何更改代码段以用分号而不是用逗号分隔csv文件?

if WScript.Arguments.Count < 2 Then
WScript.Echo "Error! Please specify the source path and the destination. Usage: XlsToCsv SourcePath.xls Destination.csv"
Wscript.Quit
End If
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(Wscript.Arguments.Item(0))
oBook.SaveAs WScript.Arguments.Item(1), 6
oBook.Close False
oExcel.Quit
WScript.Echo "Done"

5 个答案:

答案 0 :(得分:11)

您可以保留原始脚本,只需要提供一个参数来指示必须应用本地设置。这样可以保存我的CSV;分离器

if WScript.Arguments.Count < 2 Then 
  WScript.Echo "Error! Please specify the source path and the destination. Usage: XlsToCsv SourcePath.xls Destination.csv" 
  Wscript.Quit 
End If 
Dim oExcel 
Set oExcel = CreateObject("Excel.Application") 
oExcel.DisplayAlerts = FALSE 'to avoid prompts
Dim oBook, local
Set oBook = oExcel.Workbooks.Open(Wscript.Arguments.Item(0))
local = true 
call oBook.SaveAs(WScript.Arguments.Item(1), 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, local) 'this changed
oBook.Close False 
oExcel.Quit 
WScript.Echo "Done" 

答案 1 :(得分:1)

在分隔文本文件中使用逗号可以在区域设置中找到它的根源。虽然逗号在美国是标准的,但德国等其他国家则使用分号代替。您可以在“区域和语言”设置中更改“列表分隔符”值,然后从Excel的“另存为”窗口中选择CSV(逗号分隔)(.csv)。生成的文件将由系统设置中的任何值分隔。此脚本更改默认列表分隔符设置。然后它打开指定的电子表格并重新保存。它在完成之前将系统设置恢复为之前的值。

它接受两个命令行参数。第一个是输入电子表格;第二个是导出文件的输出文件名。

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

' Open spreadsheet with Excel and save it in a text delimited format
Const xlCSV = 6

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(WScript.Arguments.Item(0))
objWorkbook.SaveAs WScript.Arguments.Item(1), xlCSV
objWorkbook.Close vbFalse         ' Prevent duplicate Save dialog
objExcel.Quit

' Reset the system setting to its original value
objRegistry.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strSystemDelimiter

经过一些测试后,似乎这只能通过Excel的“另存为”对话框而不是通过命令行或自动化进行。我稍微更改了脚本以使Excel窗口可见,并使用快捷键通过Excel界面打开“另存为”对话框。这应该可以解决问题。它适用于使用Excel 2007的Vista x64。我希望这适合你。

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

' Open spreadsheet with Excel and save it in a text delimited format
Const xlCSV = 6

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = vbTrue
Set objWorkbook = objExcel.Workbooks.Open(WScript.Arguments.Item(0))

WScript.Sleep 500                 ' Delay to make sure the Excel workbook is open
strWorkbookName = objExcel.ActiveWorkbook.Name
strTitlebar = strWorkbookName
Set WshShell = CreateObject("WScript.Shell")
WshShell.AppActivate strTitlebar  ' Make the workbook active so it receives the keystrokes
WshShell.SendKeys "%fa"           ' Keyboard shortcuts for the Save As dialog
WScript.Sleep 500
WshShell.SendKeys "%tc{ENTER}"    ' Change the Save As type to CSV
If WScript.Arguments.Count > 1 Then
    WshShell.SendKeys "+{TAB}" & WScript.Arguments.Item(1)
    WScript.Sleep 500
End If                            ' This If block changes the save name if one was provided
WshShell.SendKeys "{ENTER}"       ' Save the file
WScript.Sleep 500
WshShell.SendKeys "{ENTER}"       ' Dismiss the CSV warning dialog
Set WshShell = Nothing

objWorkbook.Close vbFalse         ' Prevent duplicate Save dialog
objExcel.Quit

' Reset the system setting to its original value
objRegistry.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strSystemDelimiter

答案 2 :(得分:1)

函数SaveAs定义如下:  .SaveAs(FileName,FileFormat,Password,WriteResPassword,ReadOnlyRecommended,CreateBackup,AccessMode,ConflictResolution,AddToMru,TextCodepage,TextVisualLayout,Local)

Thas是,使用分号(如果你的区域语言选项设置正确)

ExcelObj.Workbooks(1).SaveAs csvFile,6 ,,,,,,,,,, True

答案 3 :(得分:0)

您可以使用FSO对象重新打开该文件,然后对逗号字符执行Replace()。

Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set fCSVFile = _
  oFSO.OpenTextFile("C:\path\file.csv", ForReading, FailIfNotExist, OpenAsDefault)

sFileContents = fCSVFile.ReadAll
fCSVFile.Close
sFileContents = Replace(sFileContents, ",",";"))

Set fCSVFile = oFSO.OpenTextFile("C:\path\file.csv", ForWriting, True)
fCSVFile.Write(sFileContents)
fCSVFile.Close

答案 4 :(得分:0)

我将参数更改为true,并为我工作。

if WScript.Arguments.Count < 2 Then
    WScript.Echo "Erro! Especifique origem e destino. Exemplo: XlsToCsv SourcePath.xls Destination.csv"
    Wscript.Quit
End If
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(Wscript.Arguments.Item(0))
call oBook.SaveAs(WScript.Arguments.Item(1), 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, true) --CHANGED
oBook.Close False
oExcel.Quit