Access2Base - OutputTo method accepts input from array

in addition to tables and queries.
(only for internal use - arguments not published in documentation)

Change-Id: I4c7aff878a4ff1a03dcc32baae740559d034d3ca

wizards/source/access2base/Database.xba

@@ -629,8 +629,11 @@ Public Function OutputTo(ByVal pvObjectType As Variant _
 							, ByVal Optional pvTemplateFile As Variant _
 							, ByVal Optional pvEncoding As Variant _
 							, ByVal Optional pvQuality As Variant _
+							, ByRef Optional pvHeaders As Variant _
+							, ByRef Optional pvData As Variant _
 							) As Boolean
 'Supported:	acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT		for tables and queries
+'pvHeaders and pvData (unpublished) when pvObjectType = acOutputArray
 
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 Const cstThisSub = "Database.OutputTo"
@@ -638,7 +641,7 @@ Const cstThisSub = "Database.OutputTo"
 
 	OutputTo = False
 	
-	If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery)) Then Goto Exit_Function
+	If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery, acOutputArray)) Then Goto Exit_Function
 	If IsMissing(pvObjectName) Then Call _TraceArguments()
 	If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
 	If IsMissing(pvOutputFormat) Then pvOutputFormat = ""
@@ -663,13 +666,21 @@ Const cstThisSub = "Database.OutputTo"
 	If Not Utils._CheckArgument(pvEncoding, 7, _AddNumeric()) Then Goto Exit_Function
 	If IsMissing(pvQuality) Then pvQuality = acExportQualityPrint
 	If Not Utils._CheckArgument(pvQuality, 7, _AddNumeric(), Array(acExportQualityPrint, acExportQualityScreen)) Then Goto Exit_Function
+	If pvObjectType = acOutputArray Then
+		If IsMissing(pvHeaders) Or IsMissing(pvData) Then Call _TraceArguments()
+		pvOutputFormat = "HTML"
+	End If
 
 Dim sOutputFile As String, oTable As Object
 Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutput As Boolean, sSuffix As String
 
-	'Find applicable table or query
+	If pvObjectType = acOutputArray Then
-	If pvObjectType = acOutputTable Then Set oTable = TableDefs(pvObjectName, True) Else Set oTable = Querydefs(pvObjectName, True)
+		Set oTable = Nothing
-	If IsNull(oTable) Then Goto Error_NotFound
+	Else
+		'Find applicable table or query
+		If pvObjectType = acOutputTable Then Set oTable = TableDefs(pvObjectName, True) Else Set oTable = Querydefs(pvObjectName, True)
+		If IsNull(oTable) Then Goto Error_NotFound
+	End If
 	
 	'Determine format and parameters
 	If pvOutputFormat = "" Then
@@ -698,7 +709,11 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
 	'Create file
 	Select Case sOutputFormat
 		Case UCase(acFormatHTML), "HTML"
-			bOutput = _OutputToHTML(oTable, sOutputFile, pvTemplateFile)
+			If pvObjectType = acOutputArray Then
+				bOutput = _OutputToHTML(Nothing, pvObjectName, sOutputFile, pvTemplateFile, pvHeaders, pvData)
+			Else
+				bOutput = _OutputToHTML(oTable, pvObjectName, sOutputFile, pvTemplateFile)
+			End If
 		Case UCase(acFormatODS), "ODS"
 			bOutput = _OutputToCalc(oTable, sOutputFile, acFormatODS)
 		Case UCase(acFormatXLS), "XLS"
@@ -708,7 +723,6 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
 		Case UCase(acFormatTXT), "TXT", "CSV"
 			bOutput = _OutputToCalc(oTable, sOutputFile, acFormatTXT, pvEncoding)
 	End Select
-	oTable.Dispose()
 	
 	'Launch application, if requested
 	If bOutput Then
@@ -720,6 +734,10 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
 	OutputTo = True
 	
 Exit_Function:
+	If Not IsNull(oTable) Then
+		oTable.Dispose()
+		Set oTable = Nothing
+	End If
 	Utils._ResetCalledSub(cstThisSub)
 	Exit Function
 Error_NotFound:
@@ -1225,36 +1243,50 @@ Private Function _OutputClassToHTML(ByVal pvArray As variant) As String
 End Function	'	_OutputClassToHTML	V1.4.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Private Function _OutputDataToHTML(poTable As Object, piFile As Integer) As Boolean
+Private Function _OutputDataToHTML(ByRef pvTable As Variant, ByVal pvName As String, ByVal piFile As Integer _
-'	Write html tags around data found in poTable
+									, ByRef Optional pvHeaders As Variant _
+									, ByRef Optional pvData As Variant _
+									) As Boolean
+'	Write html tags around data found in pvTable
 '	Exit when error without execution stop (to avoid file remaining open ...)
 
 Dim oTableRS As Object, vData() As Variant, i As Integer, j As Integer
 Dim vFieldsBin() As Variant, iDataType As Integer, iNumRows As Integer, iNumFields As Integer, vDataCell As Variant
+Dim bDataArray As Boolean, sHeader As String
 Dim vTrClass() As Variant, vTdClass As Variant, iCountRows As Integer, iLastRow As Integer
 Const cstMaxRows = 200
 	On Local Error GoTo Error_Function
 
+	bDataArray = IsNull(pvTable)
 	Print #piFile, "  <table class=""dbdatatable"">"
-	Print #piFile, "   <caption>" & poTable._Name & "</caption>"
+	Print #piFile, "   <caption>" & pvName & "</caption>"
 
-	Set oTableRS = poTable.OpenRecordset( , , dbReadOnly)
 	vFieldsBin() = Array()
-	iNumFields = oTableRS.Fields.Count
+	If bDataArray Then
-	ReDim vFieldsBin(0 To iNumFields - 1)
+		Set oTableRS = Nothing
-	With com.sun.star.sdbc.DataType
+		iNumFields = UBound(pvHeaders) + 1
+		ReDim vFieldsBin(0 To iNumFields - 1)
 		For i = 0 To iNumFields - 1
-			iDataType = oTableRS.Fields(i).DataType
+			vFieldsBin(i) =  False
-			vFieldsBin(i) = False
-			If iDataType = .BINARY Or iDataType = .VARBINARY Or iDataType = .LONGVARBINARY Or iDataType = .BLOB Or iDataType = .CLOB Then vFieldsBin(i) = True
 		Next i
-	End With
+	Else
+		Set oTableRS = pvTable.OpenRecordset( , , dbReadOnly)
+		iNumFields = oTableRS.Fields.Count
+		ReDim vFieldsBin(0 To iNumFields - 1)
+		With com.sun.star.sdbc.DataType
+			For i = 0 To iNumFields - 1
+				iDataType = oTableRS.Fields(i).DataType
+				vFieldsBin(i) =  Utils._IsBinaryType(iDataType)
+			Next i
+		End With
+	End If
 
 	With oTableRS
 		Print #piFile, "   <thead>"
 		Print #piFile, "    <tr>"
 		For i = 0 To iNumFields - 1
-			Print #piFile, "     <th scope=""col"">" & .Fields(i)._Name & "</th>"
+			If bDataArray Then sHeader = pvHeaders(i) Else sHeader = .Fields(i)._Name
+			Print #piFile, "     <th scope=""col"">" & sHeader & "</th>"
 		Next i
 		Print #piFile, "    </tr>"
 		Print #piFile, "   </thead>"
@@ -1262,13 +1294,21 @@ Const cstMaxRows = 200
 		Print #piFile, "   </tfoot>"
 
 		Print #piFile, "   <tbody>"
-		.MoveLast
+		If bDataArray Then
-		iLastRow = .RecordCount
+			iLastRow = UBound(pvData, 2) + 1
-		.MoveFirst
+		Else
+			.MoveLast
+			iLastRow = .RecordCount
+			.MoveFirst
+		End If
 		iCountRows = 0
-		Do While Not .EOF()
+		Do While iCountRows < iLastRow
-			vData() = .GetRows(cstMaxRows)
+			If bDataArray Then
-			iNumRows = UBound(vData, 2) + 1
+				iNumRows = iLastRow
+			Else
+				vData() = .GetRows(cstMaxRows)
+				iNumRows = UBound(vData, 2) + 1
+			End If
 			For j = 0 To iNumRows - 1
 				iCountRows = iCountRows + 1
 				vTrClass() = Array()
@@ -1281,7 +1321,7 @@ Const cstMaxRows = 200
 					If i = 0 Then vTdClass() = _AddArray(vTdClass, "firstcol")
 					If i = iNumFields - 1 Then vTdClass() = _AddArray(vTdClass, "lastcol")
 					If Not vFieldsBin(i) Then
-						vDataCell = vData(i, j)
+						If bDataArray Then vDataCell = pvData(i, j) Else vDataCell = vData(i, j)
 						Select Case VarType(vDataCell)
 							Case vbEmpty, vbNull
 								vTdClass() = _AddArray(vTdClass, "null")
@@ -1310,7 +1350,7 @@ Const cstMaxRows = 200
 			Next j
 		Loop
 
-		.mClose()
+		If Not bDataArray Then .mClose()
 	End With
 	Set oTableRS = Nothing
 
@@ -1537,9 +1577,13 @@ Error_Function:
 End Function	'	OutputToCalc	V1.4.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _OutputToHTML(poTable As Object, ByVal psOutputFile As String, ByVal psTemplateFile As String) As Boolean
+Public Function _OutputToHTML(ByRef pvTable As Variant, ByVal pvName As String, ByVal psOutputFile As String, ByVal psTemplateFile As String _
+								, ByRef Optional pvHeaders As Variant _
+								, ByRef Optional pvData As Variant _
+								) As Boolean
 '	http://www.ehow.com/how_5652706_create-html-template-ms-access.html
 
+Dim bDataArray As Boolean
 Dim vMinimalTemplate As Variant, vTemplate As Variant
 Dim iFile As Integer, i As Integer, sLine As String, lBody As Long
 Const cstTitle = "<!--Template_Title-->", cstBody = "<!--Template_Body-->"
@@ -1560,6 +1604,8 @@ Const cstTitleAlt = "<!--AccessTemplate_Title-->", cstBodyAlt =
 
 	vTemplate = _ReadFileIntoArray(psTemplateFile)
 	If LBound(vTemplate) > UBound(vTemplate) Then vTemplate() = vMinimalTemplate()
+	
+	bDataArray = IsNull(pvTable)
 
 '	Write output file
 	iFile = FreeFile()
@@ -1570,12 +1616,16 @@ Const cstTitleAlt = "<!--AccessTemplate_Title-->", cstBodyAlt =
 			sLine = Join(Split(sLine, cstBodyAlt), cstBody)
 			Select Case True
 				Case InStr(sLine, cstTitle) > 0
-					sLine = Join(Split(sLine, cstTitle), poTable._Name)
+					sLine = Join(Split(sLine, cstTitle), pvName)
 					Print #iFile, sLine
 				Case InStr(sLine, cstBody) > 0
 					lBody = InStr(sLine, cstBody)
 					If lBody > 1 Then Print #iFile, Left(sLine, lBody - 1)
-					_OutputDataToHTML(poTable, iFile)
+					If bDataArray Then
+						_OutputDataToHTML(pvTable, pvName, iFile, pvHeaders, pvData)
+					Else
+						_OutputDataToHTML(pvTable, pvName, iFile)
+					End If
 					If Len(sLine) > lBody + Len(cstBody) - 1 Then Print #iFile, Right(sLine, Len(sLine) - lBody + Len(cstBody) + 1)
 				Case Else
 					Print #iFile, sLine

wizards/source/access2base/acConstants.xba

@@ -277,6 +277,7 @@ REM -----------------------------------------------------------------
 Global Const acOutputTable = 0
 Global Const acOutputQuery = 1
 Global Const acOutputForm = 2
+Global Const acOutputArray = -1
 
 REM AcEncoding
 REM -----------------------------------------------------------------