Access2Base - DoCmd.OutputTo applicable to Calc, Excel and Text/csv formats

Database._OutputToCalc uses LO filters to export table and/or query data

Change-Id: I69b15e76a490de32ec2cae73661f8ffd5f2b53b2

3 files changed, 102 insertions, 14 deletions

diff --git a/wizards/source/access2base/Database.xba b/wizards/source/access2base/Database.xba
index 8d524b627921..2398de89fd5f 100644
--- a/wizards/source/access2base/Database.xba
+++ b/wizards/source/access2base/Database.xba
@@ -591,7 +591,7 @@ Public Function OutputTo(ByVal pvObjectType As Variant _
 							, ByVal Optional pvEncoding As Variant _
 							, ByVal Optional pvQuality As Variant _
 							) As Boolean
-'Supported:	acFormatHTML for tables and queries
+'Supported:	acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT		for tables and queries
 
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 Const cstThisSub = "Database.OutputTo"
@@ -607,8 +607,9 @@ Const cstThisSub = "Database.OutputTo"
 	If pvOutputFormat <> "" Then
 		If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _
 							UCase(acFormatHTML), "HTML" _
-							, UCase(acFormatXLS), "XLS" _
 							, UCase(acFormatODS), "ODS" _
+							, UCase(acFormatXLS), "XLS" _
+							, UCase(acFormatXLSX), "XLSX" _
 							, UCase(acFormatTXT), "TXT", "CSV" _
 							, "")) _
 				Then Goto Exit_Function				'	A 2nd time to allow case unsensitivity
@@ -625,7 +626,7 @@ Const cstThisSub = "Database.OutputTo"
 	If Not Utils._CheckArgument(pvQuality, 7, _AddNumeric(), Array(acExportQualityPrint, acExportQualityScreen)) Then Goto Exit_Function
 
 Dim sOutputFile As String, bFound As Boolean, i As Integer, iCount As Integer, oTable As Object
-Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutput As Boolean
+Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutput As Boolean, sSuffix As String
 	'Find applicable table or query
 	bFound = False
 	If pvObjectType = acOutputTable Then iCount = TableDefs.Count Else iCount = Querydefs.Count
@@ -640,17 +641,21 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
 	
 	'Determine format and parameters
 	If pvOutputFormat = "" Then
-		sOutputFormat = _PromptFormat(Array("HTML", "ODS", "XLS", "TXT"))			'	Prompt user for format
+		sOutputFormat = _PromptFormat(Array("HTML", "ODS", "XLS", "XLSX", "TXT"))			'	Prompt user for format
 		If sOutputFormat = "" Then Goto Exit_Function
-		If Not Utils._CheckArgument(UCase(sOutputFormat), 3, vbString, Array(UCase(acFormatHTML), "HTML", "")) _
-				Then Goto Exit_Function			'	Today only value, later maybe Calc ?
 	Else
 		sOutputFormat = UCase(pvOutputFormat)
 	End If
 
 	'Determine output file
 	If pvOutputFile = "" Then			'	Prompt file picker to user
-		sSuffix = "html"
+		Select Case sOutputFormat
+			Case UCase(acFormatHTML), "HTML"			:		sSuffix = "html"
+			Case UCase(acFormatODS), "ODS"				:		sSuffix = "ods"
+			Case UCase(acFormatXLS), "XLS"				:		sSuffix = "xls"
+			Case UCase(acFormatXLSX), "XLSX"				:	sSuffix = "xlsx"
+			Case UCase(acFormatTXT), "TXT", "CSV"		:		sSuffix = "txt"
+		End Select
 		sOutputFile = _PromptFilePicker(sSuffix)
 		If sOutputFile = "" Then Goto Exit_Function
 	Else
@@ -659,7 +664,18 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
 	sOutputFile = ConvertToURL(sOutputFile)
 
 	'Create file
-	bOutput = _OutputToHTML(oTable, sOutputFile, pvTemplateFile)
+	Select Case sOutputFormat
+		Case UCase(acFormatHTML), "HTML"
+			bOutput = _OutputToHTML(oTable, sOutputFile, pvTemplateFile)
+		Case UCase(acFormatODS), "ODS"
+			bOutput = _OutputToCalc(oTable, sOutputFile, acFormatODS)
+		Case UCase(acFormatXLS), "XLS"
+			bOutput = _OutputToCalc(oTable, sOutputFile, acFormatXLS)
+		Case UCase(acFormatXLS), "XLSX"
+			bOutput = _OutputToCalc(oTable, sOutputFile, acFormatXLSX)
+		Case UCase(acFormatTXT), "TXT", "CSV"
+			bOutput = _OutputToCalc(oTable, sOutputFile, acFormatTXT)
+	End Select
 	oTable.Dispose()
 	
 	'Launch application, if requested
@@ -1159,14 +1175,14 @@ End Function	'	_OutputNullToHTML	V1.4.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
 Private Function _OutputNumberToHTML(ByVal pvNumber As Variant, ByVal Optional piPrecision As Integer) As String
-'	Converts input date to HTML compatible string
+'	Converts input number to HTML compatible string
 
 Dim vNumber As Variant
 	If IsMissing(piPrecision) Then piPrecision = -1
 	If pvNumber = Int(pvNumber) Then
 		vNumber = Int(pvNumber)
 	Else
-		If piPrecision >= 0 Then vNumber = (Int(pvNumber * 10 ^ piPrecision + 0.5)) / 10 ^ piPrecision Else vNumber = Int(pvNumber)
+		If piPrecision >= 0 Then vNumber = (Int(pvNumber * 10 ^ piPrecision + 0.5)) / 10 ^ piPrecision Else vNumber = pvNumber
 	End If
 	_OutputNumberToHTML = Format(vNumber)
 
@@ -1264,6 +1280,75 @@ Dim i As Integer, l As Long
 End Function	'	_OutputStringToHTML V1.4.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputToCalc(poData As Object, ByVal psOutputFile As String, psFilter As String) As Boolean
+'	https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Database_Import
+
+Dim oCalcDoc As Object, oSheet As Object, vWin As Variant
+Dim vImportDesc() As Variant, iSource As Integer
+Dim oRange As Object, i As Integer, iCol As Integer, oColumns As Object
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	_OutputToCalc = False
+    ' Create a new OO-Calc-Document
+	Set oCalcDoc = StarDesktop.LoadComponentFromURL( _
+			"private:factory/scalc" _
+			, "_default" ,0, Array() _
+			)
+
+	' Get the unique spreadsheet
+	Set oSheet = oCalcDoc.Sheets(0)
+
+	' Describe import
+	With poData
+		If ._Type = "TABLEDEF" Then
+			iSource = com.sun.star.sheet.DataImportMode.TABLE
+		Else
+			iSource = com.sun.star.sheet.DataImportMode.QUERY
+		End If
+		vImportDesc = Array( _
+			_MakePropertyValue("DatabaseName", URL) _
+			, _MakePropertyValue("SourceType", iSource) _
+			, _MakePropertyValue("SourceObject", ._Name) _
+		)
+		oSheet.Name = ._Name
+	End With
+
+	' Import
+	oSheet.getCellByPosition(0, 0).doImport(vImportDesc())
+
+	Select Case psFilter
+		Case acFormatODS, acFormatXLS, acFormatXLSX		'	Formatting
+			iCol = poData.Fields().Count
+			Set oRange = oSheet.getCellRangeByPosition(0, 0, iCol - 1, 0)
+			oRange.CharWeight    = com.sun.star.awt.FontWeight.BOLD
+			oRange.CellBackColor = RGB(200, 200, 200)
+			oRange.HoriJustify   = com.sun.star.table.CellHoriJustify.CENTER
+			Set oColumns = oRange.getColumns()
+			For i = 0 To iCol - 1
+				oColumns.getByIndex(i).OptimalWidth = True
+			Next i
+		Case Else
+	End Select
+	
+	oCalcDoc.storeAsUrl(psOutputFile, Array( _
+			_MakePropertyValue("FilterName", psFilter) _
+			, _MakePropertyValue("Overwrite", True) _
+			))
+	oCalcDoc.close(False)
+	_OutputToCalc = True
+
+Exit_Function:
+	Set oColumns = Nothing
+	Set oRange = Nothing
+	Set oSheet = Nothing
+	Set oCalcDoc = Nothing
+	Exit Function
+Error_Function:
+    TraceError(TRACEABORT, ERRDFUNCTION, _A2B_.CalledSub, 0, , sSQL)
+    Goto Exit_Function
+End Function	'	OutputToCalc	V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _OutputToHTML(poTable As Object, ByVal psOutputFile As String, ByVal psTemplateFile As String) As Boolean
 '	http://www.ehow.com/how_5652706_create-html-template-ms-access.html
 
diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index d4f5706d51d2..ff3d5ae6b01c 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/wizards/source/access2base/DoCmd.xba
@@ -1212,9 +1212,11 @@ Public Function OutputTo(ByVal pvObjectType As Variant _
 							, ByVal Optional pvEncoding As Variant _
 							, ByVal Optional pvQuality As Variant _
 							) As Boolean
+REM https://wiki.openoffice.org/wiki/Framework/Article/Filter/FilterList_OOo_3_0
 REM https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options
+REM https://msdn.microsoft.com/en-us/library/ms709353%28v=vs.85%29.aspx
 'Supported:	acFormatPDF, acFormatODT, acFormatDOC, acFormatHTML		for forms
-'			acFormatHTML, acFormatXLS, acFormatODS, acFormatTXT	for tables and queries
+'			acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT		for tables and queries
 
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 Const cstThisSub = "OutputTo"
@@ -1230,8 +1232,8 @@ Const cstThisSub = "OutputTo"
 	If pvOutputFormat <> "" Then
 		If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _
 			UCase(acFormatPDF), UCase(acFormatODT), UCase(acFormatDOC), UCase(acFormatHTML) _
-			, UCase(acFormatXLS), UCase(acFormatODS), UCase(acFormatTXT) _
-			, "PDF", "ODT", "DOC", "HTML", "XLS", "ODS", "TXT", "CSV", "" _
+			, UCase(acFormatODS), UCase(acFormatXLS), UCase(acFormatXLSX), UCase(acFormatTXT) _
+			, "PDF", "ODT", "DOC", "HTML", "ODS", "XLS", "XLSX", "TXT", "CSV", "" _
 			)) Then Goto Exit_Function				'	A 2nd time to allow case unsensitivity
 	End If
 	If IsMissing(pvOutputFile) Then pvOutputFile = ""
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index 08e442a3c6eb..1a3db6a8e230 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/wizards/source/access2base/acConstants.xba
@@ -287,8 +287,9 @@ Global Const acFormatPDF = "writer_pdf_Export"
 Global Const acFormatODT = "writer8"
 Global Const acFormatDOC = "MS Word 97"
 Global Const acFormatHTML = "HTML"
+Global Const acFormatODS = "calc8"
 Global Const acFormatXLS = "MS Excel 97"
-Global Const acFormatODS = "StarOffice XML (Calc)"
+Global Const acFormatXLSX = "Calc MS Excel 2007 XML"
 Global Const acFormatTXT = "Text - txt - csv (StarCalc)"
 
 REM AcExportQuality