LibreOffice / OpenOffice Calc: VBscript, export of XLS sheets to CSV

Question

I'm trying to write a script for a while now but it seems that one part of it just does not work.

Situation: I need a VB script that can use any LibreOffice (/ OpenOffice) Calc (3.5.4 in my case) installation on any Windows XP or 7 system for export of xls to csv (as many csv files as there are sheets in the xls). It has to be VBS and LibreOffice in this case. No macro installed, everything controlled externally by vbscript.

So, first step was to use the macro recorder in order to get the right filter settings.

StarBasic macro:

    dim document   as object
    dim dispatcher as object

    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    dim args1(2) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "URL"
    args1(0).Value = "file:///C:/Users/lutz/Desktop/test.csv"
    args1(1).Name = "FilterName"
    args1(1).Value = "Text - txt - csv (StarCalc)"
    args1(2).Name = "FilterOptions"
    args1(2).Value = "9,0,76,1,,0,false,true,true"

    dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())

This macro (in LibreOffice) writes a CSV of the current sheet (after LO telling me that only the current sheet will be saved), encoding UTF-8, field separator Tab, no text separator. This works.

I tried to get this to work in my vbs but it absolutely did not. So I searched a lot in OpenOffice and LibreOffice forums, here at stackoverflow, etc. and used another method.

Problem: Everytime it saves the file(s) it saves them as ODS, no matter which filter or filter options I use. It always saves to zipped OpenDocument. I tried numerous Filters, even PDF. It seems that it works with pdf when I only use the FilterName property but somehow it doesn't work anymore. And I don't know why.

The code:

    ' Scripting object
    Dim wshshell
    ' File system object
    Dim objFSO
    ' OpenOffice / LibreOffice Service Manager
    Dim objServiceManager
    ' OpenOffice / LibreOffice Desktop
    Dim objDesktop
    ' Runcommand, if script does not run with Cscript
    Dim runcommand

    Dim Path
    Dim Savepath
    Dim Filename

    Dim url
    Dim args0(0)
    Dim args1(3)

    ' Create File system object
    Set wshshell = CreateObject("Wscript.Shell")
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    ' If not run in cscript, run in cscript
    if instr(1, wscript.fullname, "cscript.exe")=0 then
    runcommand = "cscript //Nologo xyz.vbs"
    wshshell.run runcommand, 1, true
    wscript.quit
    end if

    ' If files present, run Calc
    If objFSO.GetFolder(".").Files.Count>0 then
       Set objServiceManager = WScript.CreateObject("com.sun.star.ServiceManager")
       ' Create Desktop
       Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
    else
       ' If no files in directory
       wscript.echo "No files found!"
       wscript.quit
    End If

    on error resume next

    bError=False
    For each File in objFSO.GetFolder(".").Files
       if lcase(right(File.Name,3))="xls" then

       ' Access file
       url = ConvertToURL(File.Path)
       objDesktop = GlobalScope.BasicLibraries.loadLIbrary( "Tools" )
       Set args0(0) = objServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
       Set objDocument = objDesktop.loadComponentFromURL(url, "_blank", 0, args0 )

       ' Read filenames without extension or path
       Path = ConvertToURL( File.ParentFolder ) & "/"
       Filename = objFSO.GetBaseName( File.Path )
       Savepath = ConvertToURL( File.ParentFolder )

       ' set arguments
       Set args1(0) = objServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
       Set args1(1) = objServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
       Set args1(2) = objServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
       sFilterName = "Text - txt - csv (StarCalc)"
       sFilterOptions = "9,0,76,1,,0,false,true,true"
       sOverwrite = True
       Set args1(0) = MakePropertyValue( "FilterName", sFilterName )
       Set args1(1) = MakePropertyValue( "FilterOptions", sFilterOptions )
       Set args1(2) = MakePropertyValue( "Overwrite", sOverwrite )

       ' Save every sheet in separate csv file
       objSheets = objDocument.Sheets
       For i = 0 to objDocument.Sheets.getcount -1
           objSheet = objDocument.Sheets.getByIndex(i)
           Call objDocument.CurrentController.setActiveSheet(objSheet)
           Call objDocument.storeToURL( ConvertToURL( File.ParentFolder & "\" & Filename & "_" & objDocument.sheets.getByIndex(i).Name & ".csv" ), args1 )
       Next

       ' Close document
       objDocument.close(True)
       Set objDocument = Nothing
       Path = ""
       Savepath = ""
       Filename = ""

    Else
    End If

    Next

    ' Close / terminate LibreOffice
    objDesktop.terminate
    Set objDesktop = nothing
    Set objServiceManager = nothing

The function ConvertToUrl is not listed here. It is a vbscript function that converts Windows paths to URL paths (file:/// etc.). It is tested and works.

What I also tried:

• Saving in ods first (StoreAsUrl) then try to save in different format.
• Use MakePropertyValue( "SelectionOnly", true )

None of that worked nor did it combined. I used http://extensions.services.openoffice.org/de/project/OOcalc_multi_sheets_export as a source of inspiration. But it is a macro, not direct access from an external vb script.

It seems that the problem is a general one with StoreToUrl or the properties / arguments: Even FilterName "writer_pdf" or "Calc MS Excel 2007 XML" don't work. Problem is: I don't know what's the culprit here. The settings that the macro recorder uses are the same and if one uses the macro directly in LibreOffice it works.

Maybe someone knows what needs to get changed in the code or how I can get the dispatcher used in the macro to work.

Thank you for your help in advance!

Answer 1

Ok, I found the solution after days of research and tiny little information scattered everywhere. I hope that this code will serve someone well:

' Variables
Dim wshshell      ' Scripting object
Dim oFSO         ' Filesystem object
Dim runcommand   ' Runcommand, if not run in Cscript

Dim oSM      ' OpenOffice / LibreOffice Service Manager
Dim oDesk      ' OpenOffice / LibreOffice Desktop
Dim oCRef      ' OpenOffice / LibreOffice Core Reflections

Dim sFileName   ' Filename without extension
Dim sLoadUrl   ' Url for file loading
Dim sSaveUrl   ' Url for file writing
Dim args0(0)   ' Load arguments

' Create file system object
Set wshshell = CreateObject("Wscript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")

' If not run in cscript, run in cscript
if instr(1, wscript.fullname, "cscript.exe")=0 then
   runcommand = "cscript //Nologo xyz.vbs"
   wshshell.run runcommand, 1, true
   wscript.quit
end if

' If there are files, start Calc
If oFSO.GetFolder(".").Files.Count>0 then
   ' If no LibreOffice open -> run
      Set oSM = WScript.CreateObject("com.sun.star.ServiceManager")
   ' Create desktop
      Set oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
      Set oCRef = oSM.createInstance( "com.sun.star.reflection.CoreReflection" )
else
   ' If no files in directory
      wscript.quit
End If

' Error handling
on error resume next

' CSV settings for saving of file(s)
sFilterName = "Text - txt - csv (StarCalc)"
sFilterOptions = "9,0,76,1,,0,false,true,true"
sOverwrite = True

' load component for file access
oDesk = GlobalScope.BasicLibraries.loadLIbrary( "Tools" )

' load argument "hidden"
Set args0(0) = oSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue") 
Set args0(0) = MakePropertyValue("Hidden", True)

For each oFile in oFSO.GetFolder(".").Files
   if lcase(right(oFile.Name,3))="xls" then
      ' open file
         sLoadUrl = ConvertToURL(oFile.Path)
         Set oDoc = oDesk.loadComponentFromURL(sLoadUrl, "_blank", 0, args0 )
      ' read filename without extension or path
         sFileName = oFSO.GetBaseName( oFile.Path )
      ' save sheets in CSVs
         For i = 0 to oDoc.Sheets.getcount -1
            oActSheet = oDoc.CurrentController.setActiveSheet( oDoc.Sheets.getByIndex(i) )
            sSaveUrl = ConvertToURL( oFile.ParentFolder & "\" & sFileName & "_" & oDoc.sheets.getByIndex(i).Name & ".csv" )
            saveCSV oSM, oDoc, sSaveUrl, sFilterName, sFilterOptions, sOverwrite
         Next
      ' Close document
      oDoc.close(True)
      Set oDoc = Nothing
      Set oActSheet = Nothing
      sFileName = ""
      sLoadUrl = ""
      sSaveUrl = ""
   Else
   End If
Next

' Close LibreOffice
oDesk.terminate
Set oDesk = nothing
Set oSM = nothing


Function ConvertToURL(sFileName)
' Convert Windows pathnames to url

Dim sTmpFile

If Left(sFileName, 7) = "file://" Then
   ConvertToURL = sFileName
   Exit Function
End If

ConvertToURL = "file:///"
sTmpFile = oFSO.GetAbsolutePathName(sFileName)

' replace any "\" by "/"
   sTmpFile = Replace(sTmpFile,"\","/") 

' replace any "%" by "%25"
   sTmpFile = Replace(sTmpFile,"%","%25") 

' replace any " " by "%20"
   sTmpFile = Replace(sTmpFile," ","%20")

ConvertToURL = ConvertToURL & sTmpFile
End Function


Function saveCSV( oSM, oDoc, sSaveUrl, sFilterName, sFilterOptions, sOverwrite )
' Saves the open document resp. active sheet in a single file

Dim aProps( 2 ), oProp0, oProp1, oProp2, vRet

' Set filter name and write into property array
   Set oProp0      = oSM.Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
   oProp0.Name     = "FilterName"
   oProp0.Value    = sFilterName
   Set aProps( 0 ) = oProp0

' Set filter options and write into property array
   Set oProp1      = oSM.Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
   oProp1.Name     = "FilterOptions"
   oProp1.Value    = sFilterOptions
   Set aProps( 1 ) = oProp1

' Set file overwrite and write into property array
   Set oProp2      = oSM.Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
   oProp2.Name     = "Overwrite"
   oProp2.Value    = sOverwrite
   Set aProps( 2 ) = oProp2

' Save
   vRet            = oDoc.storeToURL( sSaveUrl, aProps )

End Function

I hope that at least this small contribution from me helps others.