Access2Base - Implements OutputTo table/query in HTML format

Functions to export database data contents into an HTML table
with - template file
     - use of classes for CSS styling

Change-Id: Ib62b103445ba47e2fe77c45109a62b2e49fcbbc5

wizards/source/access2base/DoCmd.xba

@@ -1210,14 +1210,18 @@ Public Function OutputTo(ByVal pvObjectType As Variant _
 							, ByVal Optional pvAutoStart As Variant _
 							, ByVal Optional pvTemplateFile As Variant _
 							, ByVal Optional pvEncoding As Variant _
+							, ByVal Optional pvQuality As Variant _
 							) As Boolean
 'Supported:	acFormatPDF, acFormatODT, acFormatDOC, acFormatHTML for forms
+'			acFormatHTML for tables and queries
 
 	If _ErrorHandler() Then On Local Error Goto Error_Function
-	Utils._SetCalledSub("OutputTo")
+Const cstThisSub = "OutputTo"
+	Utils._SetCalledSub(cstThisSub)
+
 	OutputTo = False
 	
-	If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), acSendForm) Then Goto Exit_Function
+	If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery, acOutputForm)) Then Goto Exit_Function
 	If IsMissing(pvObjectName) Then pvObjectName = ""
 	If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
 	If IsMissing(pvOutputFormat) Then pvOutputFormat = ""
@@ -1233,15 +1237,31 @@ Public Function OutputTo(ByVal pvObjectType As Variant _
 	If IsMissing(pvAutoStart) Then pvAutoStart = False
 	If Not Utils._CheckArgument(pvAutoStart, 5, vbBoolean) Then Goto Exit_Function
 	If IsMissing(pvTemplateFile) Then pvTemplateFile = ""
-	If Not Utils._CheckArgument(pvTemplateFile, 6, vbString, "") Then Goto Exit_Function
-	If IsMissing(pvEncoding) Then pvEncoding = ""
-	If Not Utils._CheckArgument(pvEncoding, 7, vbString, "") Then Goto Exit_Function
+	If Not Utils._CheckArgument(pvTemplateFile, 6, vbString) Then Goto Exit_Function
+	If IsMissing(pvEncoding) Then pvEncoding = 0
+	If Not Utils._CheckArgument(pvEncoding, 7, _AddNumeric(), Array(0, acUTF8Encoding)) 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 = acOutputTable Or pvObjectType = acOutputQuery Then
+		OutputTo = Application._CurrentDb().OutputTo( _
+					pvObjectType _
+					, pvObjectName _
+					, pvOutputFormat _
+					, pvOutputFile _
+					, pvAutoStart _
+					, pvTemplateFile _
+					, pvEncoding _
+					, pvQuality _
+					)
+		GoTo Exit_Function
+	End If
 	
 Dim vWindow As Variant, sOutputFile As String, ofForm As Object, i As Integer, bFound As Boolean
 	'Find applicable form
 	If pvObjectName = "" Then
 		vWindow = _SelectWindow()
-		If vWindow.WindowType <> acSendForm Then Goto Error_Action
+		If vWindow.WindowType <> acOutoutForm Then Goto Error_Action
 		Set ofForm = Application.Forms(vWindow._Name)
 	Else
 		bFound = False
@@ -1309,7 +1329,7 @@ Dim sOutputFormat As String, sFilter As String, oFilterData As Object, oExport A
 	OutputTo = True
 	
 Exit_Function:
-	Utils._ResetCalledSub("OutputTo")
+	Utils._ResetCalledSub(cstThisSub)
 	Exit Function
 Error_NotFound:
 	TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName))
@@ -1318,7 +1338,7 @@ Error_Action:
 	TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0)
 	Goto Exit_Function
 Error_Function:
-	TraceError(TRACEABORT, Err, "OutputTo", Erl)
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
 	GoTo Exit_Function
 Error_File:
 	TraceError(TRACEFATAL, ERRFILENOTCREATED, Utils._CalledSub(), 0, , sOutputFile)
@@ -2436,7 +2456,7 @@ Const cstComma = ","
 				& Iif(psSubject = "", "", "subject=" & psSubject & "&") _
 				& Iif(psBody = "", "", "body=" & psBody & "&")
 	If Right(sMailTo, 1) = "&" Or Right(sMailTo, 1) = "?" Then sMailTo = Left(sMailTo, Len(sMailTo) - 1)
-	sMailTo = Utils._URLEncode(sMailTo)
+	sMailTo = ConvertToUrl(sMailTo)
 	
 	oDispatch = createUnoService( "com.sun.star.frame.DispatchHelper")
 	oDispatch.executeDispatch(StarDesktop, sMailTo, "", 0, Array())

wizards/source/access2base/Recordset.xba

@@ -559,17 +559,17 @@ Dim vMatrix() As Variant, lSize As Long, iNumFields As Integer, i As Integer
 	iNumFields = RowSet.getColumns().Count - 1
 	If iNumFields < 0 Then Goto Exit_Function
 
-	ReDim vMatrix(0 To pvNumRows - 1, 0 To iNumFields)			'	Conscious opposite of MSAccess !!
+	ReDim vMatrix(0 To iNumFields, 0 To pvNumRows - 1)
 	
 	Do While Not _EOF And lSize < pvNumRows - 1
 		lSize = lSize + 1
 		For i = 0 To iNumFields
-			vMatrix(lSize, i) = _getResultSetColumnValue(RowSet, i + 1)
+			vMatrix(i, lSize) = _getResultSetColumnValue(RowSet, i + 1)
 		Next i
 		_Move("NEXT")
 	Loop
 	If lSize < pvNumRows - 1 Then				'	Resize to number of fetched records
-		ReDim Preserve vMatrix(0 To lSize, 0 To iNumFields)
+		ReDim Preserve vMatrix(0 To iNumFields, 0 To lSize)
 	End If
 
 Exit_Function:

wizards/source/access2base/Utils.xba

@@ -13,6 +13,18 @@ REM ----------------------------------------------------------------------------
 REM --- PRIVATE FUNCTIONS 								        														---
 REM -----------------------------------------------------------------------------------------------------------------------
 
+Public Function _AddArray(ByVal pvArray As Variant, pvItem As Variant) As Variant
+'Add the item at the end of the array
+
+Dim vArray() As Variant
+	If IsArray(pvArray) Then vArray = pvArray Else vArray = Array()
+	ReDim Preserve vArray(LBound(vArray) To UBound(vArray) + 1)
+	vArray(UBound(vArray)) = pvItem
+	_AddArray() = vArray()
+
+End Function
+
+REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _AddNumeric(ByVal Optional pvTypes As Variant) As Variant
 'Return on top of argument the list of all numeric types
 'Facilitates the entry of the list of allowed types in _CheckArgument calls
@@ -596,11 +608,11 @@ Dim lChar As Long, sByte1 As String, sByte2 As String, sByte3 As String
 	Select Case lChar
 		Case 48 To 57, 65 To 90, 97 To 122		'	0-9, A-Z, a-z
 			_PercentEncode = psChar
-		Case "-", ".", "_", "~"
+		Case Asc("-"), Asc("."), Asc("_"), Asc("~")
 			_PercentEncode = psChar
-		Case "!", "$", "&", "'", "(", ")", "*", "+", ",", ";", "="		'	Reserved characters used as delimitors in query strings
+		Case Asc("!"), Asc("$"), Asc("&"), Asc("'"), Asc("("), Asc(")"), Asc("*"), Asc("+"), Asc(","), Asc(";"), Asc("=")	'	Reserved characters used as delimitors in query strings
 			_PercentEncode = psChar
-		Case " ", "%"
+		Case Asc(" "), Asc("%")
 			_PercentEncode = "%" & Right("00" & Hex(lChar), 2)
 		Case 0 To 127
 			_PercentEncode = psChar
@@ -621,6 +633,46 @@ Dim lChar As Long, sByte1 As String, sByte2 As String, sByte3 As String
 
 End Function	'	_PercentEncode V1.4.0
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _ReadFileIntoArray(ByVal psFileName) As Variant
+'	Loads all lines of a text file into a variant array
+'	Any error reduces output to an empty array
+'	Input file name presumed in URL form
+
+Dim vLines() As Variant, iFile As Integer, sLine As String, iCount1 As Integer, iCount2 As Integer
+Const cstMaxLines = 16000		'	+/- the limit of array sizes in Basic
+	On Local Error GoTo Error_Function
+	vLines = Array()
+	_ReadFileIntoArray = Array()
+	If psFileName = "" Then Exit Function
+
+	iFile = FreeFile()
+	Open psFileName For Input Access Read Shared As #iFile
+	iCount1 = 0
+	Do While Not Eof(iFile) And iCount1 < cstMaxLines
+		Line Input #iFile, sLine
+		iCount1 = iCount1 + 1
+	Loop
+	Close #iFile
+
+	ReDim vLines(0 To iCount1 - 1)		'	Reading file twice preferred to ReDim Preserve for performance reasons
+	iFile = FreeFile()
+	Open psFileName For Input Access Read Shared As #iFile
+	iCount2 = 0
+	Do While Not Eof(iFile) And iCount2 < iCount1
+		Line Input #iFile, vLines(iCount2)
+		iCount2 = iCount2 + 1
+	Loop
+	Close #iFile
+
+Exit_Function:	
+	_ReadFileIntoArray() = vLines()
+	Exit Function
+Error_Function:
+	vLines = Array()
+	Resume Exit_Function
+End Function	'	_ReadFileIntoArray	V1.4.0
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Sub _ResetCalledSub(ByVal psSub As String)
 '	Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling

wizards/source/access2base/acConstants.xba

@@ -273,8 +273,14 @@ Global Const acSendTable = 0
 
 REM AcOutputObjectType
 REM -----------------------------------------------------------------
+Global Const acOutputTable = 0
+Global Const acOutputQuery = 1
 Global Const acOutputForm = 2
 
+REM AcEncoding
+REM -----------------------------------------------------------------
+Global Const acUTF8Encoding = 65001
+
 REM AcFormat
 REM -----------------------------------------------------------------
 Global Const acFormatPDF = "writer_pdf_Export"
@@ -282,6 +288,11 @@ Global Const acFormatODT = "writer8"
 Global Const acFormatDOC = "MS Word 97"
 Global Const acFormatHTML = "HTML"
 
+REM AcExportQuality
+REM -----------------------------------------------------------------
+Global Const acExportQualityPrint = 0
+Global Const acExportQualityScreen = 1
+
 REM AcSysCmdAction
 REM -----------------------------------------------------------------
 Global Const acSysCmdAccessDir = 9