Macro to export to DOCX/XLSX/PPTX

Option Explicit
Global globalDoc_OOoExtension as String 'extension used for the OOo filefornat
Global globalDoc_MSExtension as String    'extension used for the MS Office fileformat
Global globalDoc_FilterName as String    'FilterName for the export

Sub ExportAsMSOfficeX

   Dim ExportURL as new com.sun.star.util.URL 'the MS Office 2007 and later version of that document
   Dim oDoc as Object
   Dim opts(3) as new com.sun.star.beans.PropertyValue
   oDoc = ThisComponent

   ' if doc hasn't been saved yet we stop
   If oDoc.getLocation() = "" Then Exit Sub '

   ' set the globalDoc_*  variables so we know what export filters and file extension we need
   determineDocInfo(oDoc)

   ' compose new URL struct for MS Office document
   ExportURL = composeNewURL(oDoc.getLocation())

   opts(0).Name = "FilterName"
   opts(0).Value = globalDoc_FilterName
   opts(1).Name = "Overwrite"
   opts(1).Value = True
   opts(2).Name = "InteractionHandler"
   opts(2).Value = ""

   MsgBox oDoc.getLocation() & Chr$(13) & ExportURL.Complete
   oDoc.storeToURL(ExportURL.Complete,opts())
   'MsgBox CurURL.Complete & " to" & Chr$(13) & ExpURL.Complete


End Sub

Function ReplaceExtension( filename$ as String) as String
   'Dim OldExt as String
   'OldExt = Right (filename, 3 )
   ReplaceExtension = Left( filename, (Len(filename) - Len(globalDoc_OOoExtension)) ) & globalDoc_MSExtension
   'MsgBox filename & " " & ReplaceExtension
End function

Sub determineDocInfo(oDoc as Object) ' set the global variables
   If oDoc.supportsService("com.sun.star.text.TextDocument") Then
      globalDoc_FilterName  = "MS Word 2007 XML"
      globalDoc_OOoExtension  = "sxw"
      globalDoc_MSExtension  = "docx"
   Elseif oDoc.supportsService("com.sun.star.sheet.SpreadsheetDocument") Then
      globalDoc_FilterName = "MS Excel 2007 XML"
      globalDoc_OOoExtension = "sxc"
      globalDoc_MSExtension = "xlsx"
   Elseif oDoc.supportsService("com.sun.star.presentation.PresentationDocument") Then
      globalDoc_FilterName = "MS PowerPoint 2007 XML"
      globalDoc_OOoExtension = "sxi"
      globalDoc_MSExtension = "pptx"
   End if
End Sub

Function composeNewURL(stringURL as String) as com.sun.star.util.URL
   Dim CurrentURL as new com.sun.star.util.URL 'the document you are editing
   Dim NewURL as new com.sun.star.util.URL
   Dim URLParser as Object, tmp as String

   CurrentURL.Complete = stringURL
   URLParser = createUnoService("com.sun.star.util.URLTransformer")
   URLParser.parseStrict(CurrentURL)

   tmp = CurrentURL.Protocol & CurrentURL.User & CurrentURL.Password
   ' URL.Server and URL.Port make no sence if the document is local
   If (CurrentURL.Server <> "") Then
      ' CurURL.Server returns "" as a String if not set, thus we skip Server and Port
      tmp = tmp & CurrentURL.Server & CurrentURL.Port
   End if

'   tmp = tmp & CurrentURL.Path & "exported_" & ReplaceExtension(CurrentURL.Name) & CurrentURL.Arguments & CurrentURL.Mark
   tmp = tmp & CurrentURL.Path & ReplaceExtension(CurrentURL.Name) & CurrentURL.Arguments & CurrentURL.Mark
   NewURL.Complete = tmp
   URLParser.parseStrict(NewURL)
   composeNewURL = NewURL
End Function