続、OpenOffice.org Writer の .odt ファイルを覗いてみる。

VBScript で1回書いて。 そのままじゃ表（Calc ではなくて Writer で作成できる表）が存在するとエラーになるという間違いに気づいて訂正してｗ

んでも、とりあえず書いた表処理コードだと、表を構成するセル個々の内容が「セル１個＝テキスト１行」となって出力されるのがなんとなく嫌で。

セル個々に Col, Row でアクセスできれば順にたどって整形して・・・と思ったけど、Col, Row でセルを特定してアクセスする方法が判らなかったので、力技でアクセスしてみたｗ 表の１行をテキスト１行として出力。 セルの区切りはタブを挟む。 縦３行、横４列の表なら３行のテキストで、１行は４個の内容と３個のタブ・・・という感じで。 セルの中の改行は除去して、なるべく表のレイアウト構造を保つようにして・・ って、なんかイマイチなコードだ・・・もうちょっとシンプルに書きたかったな。

ついでに Calc の表を OLE で貼り付けた場合はどうやってアクセスすればいいのかなと思って調べたけど判らなかったｗ

Writer のデータをたどる時、LoadComponentFromURL()でファイルを読み込んでから、トップレベル（？）から .Text.createEnumeration でテキストの列挙型データ群を取ってるから、その中には OLE オブジェクトは含まれないだろうし・・・。 たとえば二つのパラグラフの間に挿入された Calc の OLE オブジェクトがあった時、パラグラフ→OLEオブジェクト→パラグラフと順にアクセスするにはどうすればいいんだろう・・と考えて。 んじゃ、OpenOffice.org Writer でテキスト出力してみたらどうなるのかと思って試してみたら、OLEオブジェクトの内容は出てこなかったｗ

ついでに、Writer 表の中身は１セル＝１行として出力されてた。 いや、セル内で改行している場合は、その改行もそのまま出力。 表のレイアウト構造が完全に失われるのは、ちょっとアレだな。

Option Explicit

'引数の受け取り
Dim args
Set args = Wscript.Arguments
If args.Count <> 1 Then
  WScript.Echo "Usage: " & WScript.ScriptName & " odt-file"
  WScript.Quit
End If

'odtファイルのフルパスを得る
Dim oFs
Set oFs = CreateObject("Scripting.FileSystemObject")
Dim sFile
sFile = oFs.GetAbsolutePathName(args.item(0))
Set oFs = Nothing

'OOoの準備
Dim oOOoServiceManager
Set oOOoServiceManager _ 
  = WScript.CreateObject("com.sun.star.ServiceManager")
CheckError

Dim oOOoDesktop
Set oOOoDesktop _ 
  = oOOoServiceManager.createInstance("com.sun.star.frame.Desktop")
CheckError

'OOoデスクトップウィンドウ非表示のためのプロパティ準備
Dim oPropertyValue
Set oPropertyValue _ 
  = oOOoServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
oPropertyValue.Name = "Hidden"
oPropertyValue.Value = True

'odtファイルの読み込み
Dim oODT
Set oODT _ 
  = oOOoDesktop.LoadComponentFromURL(_ 
  "file:///" & Replace(sFile, "\", "/"), _ 
  "_blank", 0, Array(oPropertyValue)) 'OOoデスクトップウィンドウ非表示
CheckError
Set oPropertyValue = Nothing

'odtファイルの中のテキストを拾い上げる
Dim oEnum
Set oEnum = oODT.Text.createEnumeration
CheckError
Dim oTextElement
Dim sBody
sBody = ""
While oEnum.hasMoreElements
  Set oTextElement = oEnum.nextElement
  CheckError
  If oTextElement.supportsService("com.sun.star.text.Paragraph") Then
    sBody = sBody & oTextElement.String & VbCrLf
  ElseIf oTextElement.supportsService("com.sun.star.text.TextTable") Then
    sBody = sBody & ConvTableToText(oTextElement) & VbCrLf
  End If
  Set oTextElement = Nothing
Wend

WScript.Echo sBody

Set oTextElement = Nothing
Set oEnum = Nothing

oODT.Dispose
CheckError
Set oODT = Nothing

'OOoデスクトップが他にドキュメントを開いてなければ
Dim oDocs
Set oDocs = oOOoDesktop.getComponents().createEnumeration()
If Not oDocs.hasMoreElements() Then 
  oOOoDesktop.Terminate '閉じる
  CheckError
End If

Set oDocs = Nothing
Set oOOoDesktop = Nothing
Set oOOoServiceManager = Nothing

WScript.Echo "End."
WScript.Quit 

'---------------------------------------------------------------------------
Function CheckError()
  If Err.Number < 1 Then Exit Function
  MsgBox "エラーが発生しました。" & VBCrLf _ 
    & "実行スクリプト: " & WScript.ScriptFullName & VBCrLf _ 
    & "エラー番号: " & CStr(Err.Number) & VBCrLf _ 
    & "エラーメッセージ: " & Err.Description & VBCrLf _ 
    & "日時: " & Now & VBCrLf & VBCrLf , _ 
    vbOKOnly + vbCritical
  WScript.Quit '終了
End Function
'---------------------------------------------------------------------------
Function ConvTableToText(oTbl)
  ConvTableToText = ""
  Dim sCellNames
  sCellNames = oTbl.getCellNames
  Dim oCell
  Dim posRow
  Dim posRowTest
  Dim posNum
  posNum = InNumChrPos(sCellNames(0))
  posRow = CInt(Right(sCellNames(0), Len(sCellNames(0))-(posNum-1)) )
  Dim i
  Dim sep
  sep = ""
  For i = 0 To UBound(sCellNames)
    Set oCell = oTbl.getCellByName(sCellNames(i))
    posNum = InNumChrPos(sCellNames(i))
    posRowTest = CInt(Right(sCellNames(i), Len(sCellNames(i))-(posNum-1)) )
    If (posRow <> posRowTest) Then
      ConvTableToText = ConvTableToText & VbCrLf
      posRow = posRowTest
      sep = ""
    End If
    ConvTableToText = ConvTableToText & sep _ 
      & Replace(oCell.String, VBCrLf, "", 1, -1, vbTextCompare)
    sep = VbTab
  Next
End Function
'---------------------------------------------------------------------------
Function InNumChrPos(sTest)
  InNumChrPos = 0
  If (Len(sTest) = 0) Then Exit Function
  Dim posTest
  Dim posKeep
  posKeep = Len(sTest) + 1
  Dim i
  For i = 0 To 9
    posTest = InStr(1, sTest, CStr(Chr(Asc("0") + i)), vbTextCompare)
    If (posTest > 0) And (posKeep >= posTest) Then posKeep = posTest
  Next
  If (posKeep > Len(sTest)) Then posKeep = 0
  InNumChrPos = posKeep
End Function
'---------------------------------------------------------------------------

WinMerge のプラグインも同様に書き換えればOKか。

んでも、埋め込まれたOLEオブジェクトの内容を扱えないから、差異検出としては弱いなぁ・・・　うーん。