Excel – Convert xls / xlsx files (all sheets) to csv using VBScript (delimited by semicolons)

csvexcelvbscriptxls

I need to convert an excel file (*.xls , *.xlsx) including ALL worksheets inside into a CSV file split per sheet.
The output CSV file(s) should be named by SheetName(s) and delimited by semi-colons, instead of commas.
I have done this, by bonding several VBS scripts into one, but I still have there a bug.
My code below does convertion for all sheets in XLS file delimited by semicolons,named by sheets – BUT a little bug is that if there is more than 1 worksheet, the contents of next sheets are overwritten by a first sheet.
Whats wrong there please? Im running it in cmd with:
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

Best Answer

You are trying to save a WorkSheet, yet you are using the WorkBook object. Try using the WorkSheet object you've extracted with the For statement

 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

This works for me.

I've changed your "sheet" to "WorkSheet" just to emphasize the difference. Of course "sheet" or any other object name will work just fine.

Related Topic