我现在正在尝试编写一个脚本,但似乎其中的一部分不起作用。

情况: 我需要一个 VB 脚本,它可以在任何 Windows XP 或 7 系统上使用任何 LibreOffice (/OpenOffice) Calc(在我的情况下为 3.5.4)安装,以便将 xls 导出到 csv(与工作表一样多的 csv 文件)在 xls 中)。在这种情况下,它必须是 VBS 和 LibreOffice。没有安装宏,一切都由 vbscript 外部控制。

因此,第一步是使用宏记录器以获得正确的过滤器设置。

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

这个宏(在 LibreOffice 中)写入当前工作表的 CSV(在 LO 告诉我只会保存当前工作表之后),编码 UTF-8,字段分隔符 Tab,无文本分隔符。这有效。

我试图让它在我的 vbs 中工作,但它绝对没有。所以我在 OpenOffice 和 LibreOffice 论坛中搜索了很多,在 stackoverflow 等等,并使用了另一种方法。

问题: 每次保存文件时,它都会将它们保存为 ODS,无论我使用哪种过滤器或过滤器选项。它总是保存到压缩的 OpenDocument 中。我尝试了许多过滤器,甚至是 PDF。当我只使用 FilterName 属性时,它似乎可以与 pdf 一起使用,但不知何故它不再起作用。我不知道为什么。

代码:
    ' 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

此处未列出函数 ConvertToUrl。它是一个将 Windows 路径转换为 ​​URL 路径(file:///等)的 vbscript 函数。它经过测试并有效。

我也尝试过:
  • 首先保存在 ods (StoreAsUrl) 中,然后尝试以不同的格式保存。
  • 使用 MakePropertyValue( "SelectionOnly", true )

  • 这些都没有奏效,也没有结合起来。我使用 http://extensions.services.openoffice.org/de/project/OOcalc_multi_sheets_export 作为灵感来源。但它是一个宏,而不是从外部 vb 脚本直接访问。

    似乎问题是 StoreToUrl 或属性/参数的一般问题:
    甚至 FilterName "writer_pdf"或 "Calc MS Excel 2007 XML"也不起作用。问题是:我不知道这里的罪魁祸首是什么。宏记录器使用的设置是相同的,如果直接在 LibreOffice 中使用宏,它就可以工作。

    也许有人知道需要在代码中更改什么,或者我如何让宏中使用的调度程序工作。

    提前谢谢你的帮助!

    最佳答案

    好的,经过几天的研究和散落各处的微小信息,我找到了解决方案。我希望这段代码能很好地为某人服务:

    ' 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
    

    我希望至少我的这一小贡献可以帮助他人。

    10-08 13:29
    查看更多