【VBS】【LibreOffice】【OpenOffice 解決済み】ファイルの保存ができない

お世話になっております

表題の通りです
保存ができず　困っております

[automation bridge] : com.sun.star.task.ErrorCodeIOException: SfxBaseModel::storeSelf: 0x31c
上記エラーメッセージが出ます

分かる方ご教示宜しくお願い致します

VBScript
1 
2
3Dim objWshShell
4Set objWshShell = WScript.CreateObject("WScript.Shell")
5
6
7
8set oFSObj = CreateObject("Scripting.FileSystemObject")
9oFile = "test.xls"
10oAbsFile = oFSObj.GetAbsolutePathName(oFile)
11
12
13fpassname = oAbsFile
14
15drv = left(fpassname,1)
16fpassname = "file:///" & drv & "|/" & mid(fpassname,4)
17
18
19Set OSM = WScript.CreateObject("com.sun.star.ServiceManager")
20Set oDesktop = OSM.createInstance("com.sun.star.frame.Desktop")
21
22Dim Result() 'As Object
23dummyArray = Result
24
25
26Set oCalcDoc = oDesktop.loadComponentFromURL(fpassname , "_blank", 0 ,dummyArray)
27
28
29Set oSheet = oCalcDoc.Sheets.getByName("Sheet1")
30
31
32call oCalcDoc.store()
33

LibreOfficeではエラーが出ますが OpenOffice では下記コードで動作するみたいです

vbs
1call SaveFile(oFile)
2
3Function urlEncode(str)
4  Dim oSjisStream, oUTFStream
5  Dim strSjis, strUTF, strEnc
6  Dim result()
7  Dim space
8  space = "%20"
9  urlEncode = ""
10  If str = "" Then Exit Function
11' 
12  set oUTFStream = CreateObject("ADODB.Stream")
13  oUTFStream.Mode = 3
14  oUTFStream.Type = 2      'text data
15  oUTFStream.CharSet = "UTF-8"
16  oUTFStream.Open
17  oUTFStream.WriteText str
18' 
19  oUTFStream.Position = 0   'rewaind
20  oUTFStream.Type = 1       'binary data
21  oUTFStream.Position = 3
22  strUTF = oUTFStream.Read 
23  ReDim result(UBound(strUTF)+1)  'into byte array
24  For i=1 To UBound(strUTF)+1
25    
26    b = AscB(MidB(strUTF, i, 1))
27    
28      if (b >= 97 and b<= 122) or (b >= 65 and b<= 90) or (b >= 48 and b<= 57) or (b >= 45 and b<= 46) or (b = 95) or (b = 126) then
29         result(i) = Chr(b)
30      ElseIf b = 32 then
31         result(i) = space 
32      ElseIf (b >= 0 and b<= 15) then
33         result(i) = "%0" & Hex(b)
34      Else
35         result(i) = "%" & Hex(b)
36      end if
37  Next
38
39  urlEncode = Join(result, "")
40  
41
42  set oSjisStream = Nothing
43  set oUTFStream  = Nothing
44End Function
45
46SUB SaveFile(oFile)
47
48    
49   
50   Dim  saveparam0,saveparam1,saveparam2
51   Dim  storeProps(2)
52   
53    passname = "file:///" +  urlEncode(oFile)
54    
55    passname = Replace(passname,"\","/")
56    passname = Replace(passname,"%5C","/")
57    passname = Replace(passname,"%3A",":")
58    passname = Replace(passname,"%2E",".")
59    
60   
61    Set saveparam0 = OSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
62    saveparam0.Name = "URL"
63    saveparam0.Value = passname
64    Set storeProps(0) = saveparam0
65
66    Set saveparam1 = OSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
67    saveparam1.Name = "FilterName"
68    saveparam1.Value = "MS Excel 97"
69    Set storeProps(1) = saveparam1
70
71    Set saveparam2 = OSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
72    saveparam2.Name = "Overwrite"
73    saveparam2.Value = True
74    Set storeProps(2) = saveparam2
75
76    dim Frame , DispatchHelper
77    Set Frame = oCalcDoc.getCurrentController().getFrame()
78    
79    Set DispatchHelper = OSM.createInstance("com.sun.star.frame.DispatchHelper")
80    call DispatchHelper.executeDispatch(Frame, ".uno:SaveAs", "", 0, storeProps)
81   
82
83end sub

行動規範の内容に同意します

回答1件

自己解決

ファイルを開くダイアログで Open したところ解決いたしました

vbs
1Set OSM = WScript.CreateObject("com.sun.star.ServiceManager")
2Set oDesktop = OSM.createInstance("com.sun.star.frame.Desktop")
3
4fpassname = OpenFile2()
5
6Call SaveFile3(fpassname)
7
8Function OpenFile2()
9
10Dim oFilePicker 
11
12Dim nDlgResult 
13
14Dim sFiles() 
15
16Dim sFilename 
17
18OpenFile2 = ""
19
20set oFilePicker = OSM.createInstance("com.sun.star.ui.dialogs.FilePicker")
21Dim filename
22
23Dim args(0)
24 args(0) =  "com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE"
25 With oFilePicker
26  .initialize(args)
27  .setTitle "ファイルを開く"
28  .AppendFilter "Excelのファイル (*.xls;*.xlsx)", "*.xls;*.xlsx"
29  .SetCurrentFilter "Excelのファイル (*.xls;*.xlsx)"
30  
31 
32 End With
33 
34
35nDlgResult = oFilePicker.execute()
36
37
38IF nDlgResult <> 1 Then
39   Exit Function
40END IF 
41
42sFilename = oFilePicker.getFiles()(0)
43
44OpenFile2 = sFilename
45
46End Function
47
48Sub SaveFile3(passname)
49
50 
51   
52   dim aprps(2) , saveparam0,saveparam1,saveparam2
53    
54
55    passname = Replace(passname,"\","/")
56    passname = Replace(passname,"%5C","/")
57    passname = Replace(passname,"%3A",":")
58    passname = Replace(passname,"%2E",".")
59  
60    
61
62    Dim  storeProps(2)
63    
64    Set saveparam0 = OSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
65    saveparam0.Name = "URL"
66    saveparam0.Value = passname
67    Set storeProps(0) = saveparam0
68
69    Set saveparam1 = OSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
70    saveparam1.Name = "FilterName"
71    saveparam1.Value = "MS Excel 97"
72    Set storeProps(1) = saveparam1
73
74    Set saveparam2 = OSM.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
75    saveparam2.Name = "Overwrite"
76    saveparam2.Value = True
77    Set storeProps(2) = saveparam2
78
79    dim Frame , DispatchHelper
80    Set Frame = oCalcDoc.getCurrentController().getFrame()
81  
82    Set DispatchHelper = OSM.createInstance("com.sun.star.frame.DispatchHelper")
83    call DispatchHelper.executeDispatch(Frame, ".uno:SaveAs", "", 0, storeProps)
84    
85
86End Sub