Question

我正在尝试编写一段时间的脚本，但似乎它的一部分不起作用。

情况：我需要一个VB脚本，可以在任何Windows XP或7系统上使用任何LibreOffice（/ OpenOffice）Calc（在我的情况下为3.5.4）安装，以便将xls导出到csv（与xls中的表格一样多的csv文件。在这种情况下，它必须是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 < / em>，没有文本分隔符。这很有效。

我试图让这个在我的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 功能。它是一个vbscript函数，可将Windows路径转换为URL路径（file：///等）。经过测试和运作。

我也尝试过：

先保存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中使用宏，它就可以工作。

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

提前感谢您的帮助！

Answer 1

好的，我经过几天的研究后找到了解决方案，并且到处都散布着微小的信息。我希望这段代码可以很好地为某人服务：

' 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

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

LibreOffice / OpenOffice Calc：VBscript，将XLS表格导出为CSV

1 个答案: