Estoy tratando de escribir un guión por un tiempo, pero parece que una parte simplemente no funciona.

Situación: necesito un script VB que pueda usar cualquier instalación de LibreOffice (/ OpenOffice) Calc (3.5.4 en mi caso) en cualquier sistema Windows XP o 7 para exportar xls a csv (tantos csv archivos ya que hay hojas en el xls). Tiene que ser VBS y LibreOffice en este caso. No hay macro instalada, todo controlado externamente por vbscript.

Entonces, el primer paso fue usar la grabadora de macros para obtener la configuración de filtro correcta.

Macro de StarBasic:

    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())

Esta macro (en LibreOffice) escribe un CSV de la hoja actual (después de LO que me dice que solo se guardará la hoja actual), codificando UTF-8 , separador de campo Tab , sin separador de texto. Esto funciona.

Traté de que esto funcionara en mi vbs, pero no fue así. Así que busqué mucho en los foros de OpenOffice y LibreOffice, aquí en stackoverflow, etc. y usé otro método.

Problema: cada vez que guarda los archivos, los guarda como ODS, independientemente del filtro o las opciones de filtro que utilice. Siempre se guarda en OpenDocument comprimido. Probé numerosos filtros, incluso PDF. Parece que funciona con pdf cuando solo uso la propiedad FilterName pero de alguna manera ya no funciona. Y no sé por qué.

El código:

    ' 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

La función ConvertToUrl no se incluye aquí. Es una función vbscript que convierte las rutas de Windows en rutas URL (archivo: ///, etc.). Está probado y funciona.

Lo que también probé:

  • Guardar primero en ods (StoreAsUrl) y luego intentar guardar en un formato diferente.
  • Utilice MakePropertyValue ("SelectionOnly", verdadero)

Nada de eso funcionó ni se combinó. Usé http://extensions.services.openoffice.org/de/project/OOcalc_multi_sheets_export como fuente de inspiración. Pero es una macro, no un acceso directo desde un script vb externo.

Parece que el problema es general con StoreToUrl o las propiedades / argumentos: Incluso FilterName "writer_pdf" o "Calc MS Excel 2007 XML" no funcionan. El problema es: no sé cuál es el culpable aquí. La configuración que usa la grabadora de macros es la misma y si se usa la macro directamente en LibreOffice, funciona.

Tal vez alguien sepa qué debe cambiarse en el código o cómo puedo hacer que funcione el despachador en la macro.

Gracias por su ayuda de antemano!

4
Devnul 18 may. 2012 a las 22:29

1 respuesta

La mejor respuesta

Ok, encontré la solución después de días de investigación y una pequeña cantidad de información esparcida por todas partes. Espero que este código le sirva a alguien:

' 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

Espero que al menos esta pequeña contribución mía ayude a otros.

7
Devnul 21 may. 2012 a las 23:52