3 Dim Interactive
As Boolean
6 Function Convert(Optional inFileURL
, Optional filterSpec
, Optional outFileURL
)
7 Dim inDoc
, inDocType
, openParams
, closeInDoc
, presentationDoc
9 ' Set Interactivity i.e., LogMessage pops up a message.
15 BasicLibraries
.LoadLibrary("Tools")
16 ' BasicLibraries.LoadLibrary("XrayTool")
18 ' Setup Export filters
21 ' Export to doc format by default
22 If IsMissing(filterSpec
) Then
24 filterSpec
= InputBox("Export to: ")
29 filterSpec
= Trim(filterSpec
)
32 If IsMissing(inFileURL
) Then
33 ' Most likely, the Macro is run interactively. Act on
34 ' the current document
35 If Not ThisComponent
.HasLocation() Then
36 LogMessage("Document doesn't have a location")
41 inFileURL
= inDoc
.GetLocation()
47 openParams
= Array(MakePropertyValue("Hidden", True),MakePropertyValue("ReadOnly", True),)
50 inDoc
= StarDesktop
.loadComponentFromURL(inFileURL
, "_blank", 0, OpenParams())
54 If IsMissing(outFileURL
) Then
55 outFileURL
= GetURLWithoutExtension(inFileURL
)
58 If ExportDocument(inDoc
, filterSpec
, outFileURL
) Then
62 LogMessage("filterSpec1 is " & filterSpec
)
64 ' Export didn't go through. Maybe didn't find a valid filter.
66 ' Check whether the request is to convert a Text or a Web
67 ' Document to a Presentation Document
69 inDocType
= GetDocumentType(inDoc
)
70 If (inDocType
= "com.sun.star.text.TextDocument" Or _
71 inDocType
= "com.sun.star.text.WebDocument") Then
72 LogMessage("Filterspec2 is " & filterSpec
)
73 filter
= GetFilter("com.sun.star.presentation.PresentationDocument", filterSpec
)
74 If IsNull(filter
) Then
75 LogMessage("We tried our best. Nothing more to do"
78 LogMessage("Trying to create presentation document. Found valid filter for " & filterSpec
)
84 ' Export Outline to Presentation
85 dispatcher
= createUnoService("com.sun.star.frame.DispatchHelper")
86 dispatcher
.executeDispatch(inDoc
.CurrentController
.Frame
, ".uno:SendOutlineToStarImpress", "", 0, Array())
88 ' Dispatch event above is aynchronous. Wait for a few seconds for the above event to finish
91 ' After the dispatch, the current component is a presentation
92 ' document. Note that it doesn't have a location
94 presentationDoc
= ThisComponent
95 If IsNull(ExportDocument(presentationDoc
, filter
, outFileURL
)) Then
98 presentationDoc
.Close(True)
102 LogMessage("Successfully exported to " & outFileURL
)
106 LogMessage("Export failed " & outFileURL
)
115 ' http://codesnippets.services.openoffice.org/Writer/Writer.MergeDocs.snip
116 ' http://user.services.openoffice.org/en/forum/viewtopic.php?f=20&t=39983
117 ' http://user.services.openoffice.org/en/forum/viewtopic.php?f=21&t=23531
119 ' http://wiki.services.openoffice.org/wiki/Documentation/BASIC_Guide/Files_and_Directories_%28Runtime_Library%29
122 Function ExportDocument(inputDoc
, filterSpec
, outFileURL
) As Boolean
123 Dim inputDocType
, filter
124 ExportDocument
= False
126 On Error Goto Failure
127 inputDocType
= GetDocumentType(inputDoc
)
129 If IsArray(filterSpec
) Then
130 ' Filter is fully specified
133 ' Filter is specified by it's name
134 filter
= GetFilter(inputDocType
, filterSpec
)
137 If InStr(outFileURL
, ".") = 0 Then
138 outFileURL
= outFileURL
& "." & FilterSaveExtension(filter
)
141 LogMessage("outFileURL is " & outFileURL
)
143 inputDoc
.storeToUrl(outFileURL
, Array(MakePropertyValue("FilterName", FilterHandler(filter
))))
145 ExportDocument
= True
146 LogMessage("Export to " & outFileURL
& " succeeded")
151 LogMessage("Export to " & outFileURL
& " failed")
156 Function GetURLWithoutExtension(s
As String)
160 GetURLWithoutExtension
= s
162 GetURLWithoutExtension
= Left(s
, pos
- 1)
166 Function GetDocumentType(oDoc
)
167 For Each docType
in DocTypes
168 If (oDoc
.supportsService(docType
)) Then
169 GetDocumentType
= docType
173 GetDocumentType
= Nothing
176 Function MakePropertyValue(Optional sName
As String, Optional sValue
) As com
.sun
.star
.beans
.PropertyValue
177 Dim oPropertyValue
As New com
.sun
.star
.beans
.PropertyValue
179 If Not IsMissing(sName
) Then
180 oPropertyValue
.Name
= sName
183 If Not IsMissing(sValue
) Then
184 oPropertyValue
.Value
= sValue
187 MakePropertyValue() = oPropertyValue
192 Sub LogMessage(message
)
195 Print
"Error " & Err
& ": " & Error$
& " (line : " & Erl
& ")"