SHARE
TWEET

Macro to export to DOCX/XLSX/PPTX

a guest Oct 5th, 2018 256 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2. Global globalDoc_OOoExtension as String 'extension used for the OOo filefornat
  3. Global globalDoc_MSExtension as String    'extension used for the MS Office fileformat
  4. Global globalDoc_FilterName as String    'FilterName for the export
  5.  
  6. Sub ExportAsMSOfficeX
  7.  
  8.    Dim ExportURL as new com.sun.star.util.URL 'the MS Office 2007 and later version of that document
  9.    Dim oDoc as Object
  10.    Dim opts(3) as new com.sun.star.beans.PropertyValue
  11.    oDoc = ThisComponent
  12.    
  13.    ' if doc hasn't been saved yet we stop    
  14.    If oDoc.getLocation() = "" Then Exit Sub '
  15.    
  16.    ' set the globalDoc_*  variables so we know what export filters and file extension we need
  17.    determineDocInfo(oDoc)
  18.    
  19.    ' compose new URL struct for MS Office document
  20.    ExportURL = composeNewURL(oDoc.getLocation())
  21.    
  22.    opts(0).Name = "FilterName"
  23.    opts(0).Value = globalDoc_FilterName
  24.    opts(1).Name = "Overwrite"
  25.    opts(1).Value = True
  26.    opts(2).Name = "InteractionHandler"
  27.    opts(2).Value = ""
  28.    
  29.    MsgBox oDoc.getLocation() & Chr$(13) & ExportURL.Complete
  30.    oDoc.storeToURL(ExportURL.Complete,opts())
  31.    'MsgBox CurURL.Complete & " to" & Chr$(13) & ExpURL.Complete
  32.    
  33.  
  34. End Sub
  35.  
  36. Function ReplaceExtension( filename$ as String) as String
  37.    'Dim OldExt as String
  38.    'OldExt = Right (filename, 3 )
  39.    ReplaceExtension = Left( filename, (Len(filename) - Len(globalDoc_OOoExtension)) ) & globalDoc_MSExtension
  40.    'MsgBox filename & " " & ReplaceExtension
  41. End function
  42.  
  43. Sub determineDocInfo(oDoc as Object) ' set the global variables
  44.    If oDoc.supportsService("com.sun.star.text.TextDocument") Then
  45.       globalDoc_FilterName  = "MS Word 2007 XML"
  46.       globalDoc_OOoExtension  = "sxw"
  47.       globalDoc_MSExtension  = "docx"
  48.    Elseif oDoc.supportsService("com.sun.star.sheet.SpreadsheetDocument") Then
  49.       globalDoc_FilterName = "MS Excel 2007 XML"
  50.       globalDoc_OOoExtension = "sxc"
  51.       globalDoc_MSExtension = "xlsx"
  52.    Elseif oDoc.supportsService("com.sun.star.presentation.PresentationDocument") Then
  53.       globalDoc_FilterName = "MS PowerPoint 2007 XML"
  54.       globalDoc_OOoExtension = "sxi"
  55.       globalDoc_MSExtension = "pptx"
  56.    End if
  57. End Sub    
  58.    
  59. Function composeNewURL(stringURL as String) as com.sun.star.util.URL
  60.    Dim CurrentURL as new com.sun.star.util.URL 'the document you are editing
  61.    Dim NewURL as new com.sun.star.util.URL
  62.    Dim URLParser as Object, tmp as String
  63.    
  64.    CurrentURL.Complete = stringURL
  65.    URLParser = createUnoService("com.sun.star.util.URLTransformer")
  66.    URLParser.parseStrict(CurrentURL)    
  67.    
  68.    tmp = CurrentURL.Protocol & CurrentURL.User & CurrentURL.Password
  69.    ' URL.Server and URL.Port make no sence if the document is local
  70.    If (CurrentURL.Server <> "") Then
  71.       ' CurURL.Server returns "" as a String if not set, thus we skip Server and Port
  72.       tmp = tmp & CurrentURL.Server & CurrentURL.Port
  73.    End if
  74.  
  75. '   tmp = tmp & CurrentURL.Path & "exported_" & ReplaceExtension(CurrentURL.Name) & CurrentURL.Arguments & CurrentURL.Mark
  76.    tmp = tmp & CurrentURL.Path & ReplaceExtension(CurrentURL.Name) & CurrentURL.Arguments & CurrentURL.Mark
  77.    NewURL.Complete = tmp
  78.    URLParser.parseStrict(NewURL)
  79.    composeNewURL = NewURL
  80. End Function
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top