4

しばらくの間、スクリプトを作成しようとしていますが、一部が機能していないようです。

状況: xlsをcsvにエクスポートするために、任意のWindows XPまたは7システムでLibreOffice(/ OpenOffice)Calc(私の場合は3.5.4)のインストールを使用できるVBスクリプトが必要です(シートにあるシートと同じ数の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 でマクロを直接使用すると機能します。

コードで何を変更する必要があるか、またはマクロで使用されるディスパッチャを機能させる方法を誰かが知っているかもしれません。

事前に助けてくれてありがとう!

4

1 に答える 1

7

わかりました、何日にもわたる調査と小さな小さな情報がいたるところに散らばっていた後、解決策を見つけました。このコードが誰かに役立つことを願っています:

' 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

少なくとも私からのこの小さな貢献が他の人に役立つことを願っています.

于 2012-05-21T19:52:23.763 に答える