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/Database.xba

@@ -581,6 +581,104 @@ Error_NotApplicable:
 	Goto Exit_Function
 End Function		'	OpenSQL		V1.1.0
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function OutputTo(ByVal pvObjectType As Variant _
+							, ByVal Optional pvObjectName As Variant _
+							, ByVal Optional pvOutputFormat As Variant _
+							, ByVal Optional pvOutputFile 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:	acFormatHTML for tables and queries
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = "Database.OutputTo"
+	Utils._SetCalledSub(cstThisSub)
+
+	OutputTo = False
+	
+	If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery)) 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 = ""
+	If Not Utils._CheckArgument(pvOutputFormat, 3, vbString) Then Goto Exit_Function
+	If pvOutputFormat <> "" Then
+		If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array(UCase(acFormatHTML), "HTML", "")) _
+				Then Goto Exit_Function				'	A 2nd time to allow case unsensitivity
+	End If
+	If IsMissing(pvOutputFile) Then pvOutputFile = ""
+	If Not Utils._CheckArgument(pvOutputFile, 4, vbString) Then Goto Exit_Function
+	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 = 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
+
+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
+	'Find applicable table or query
+	bFound = False
+	If pvObjectType = acOutputTable Then iCount = TableDefs.Count Else iCount = Querydefs.Count
+	For i = 0 To iCount
+		If pvObjectType = acOutputTable Then Set oTable = TableDefs(i) Else Set oTable = Querydefs(i)
+		If UCase(oTable._Name) = UCase(pvObjectName) Then
+			bFound = True
+			Exit For
+		End If
+	Next i
+	If Not bFound Then Goto Error_NotFound
+	
+	'Determine format and parameters
+	If pvOutputFormat = "" Then
+		sOutputFormat = _PromptFormat()			'	Prompt user for format
+		If sOutputFormat = "" Then Goto Exit_Function
+		If Not Utils._CheckArgument(UCase(pvOutputFormat), 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
+		sOutputFile = _PromptFilePicker(sSuffix)
+		If sOutputFile = "" Then Goto Exit_Function
+	Else
+		sOutputFile = pvOutputFile
+	End If	
+	sOutputFile = ConvertToURL(sOutputFile)
+
+	'Create file
+	bOutput = _OutputToHTML(oTable, sOutputFile, pvTemplateFile)
+	Set oTable = Nothing
+	
+	'Launch application, if requested
+	If bOutput Then
+		If pvAutoStart Then Call _ShellExecute(sOutputFile)
+	Else
+		GoTo Error_File
+	End If
+
+	OutputTo = True
+	
+Exit_Function:
+	Utils._ResetCalledSub(cstThisSub)
+	Exit Function
+Error_NotFound:
+	TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName))
+	Goto Exit_Function
+Error_Function:
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
+	GoTo Exit_Function
+Error_File:
+	TraceError(TRACEFATAL, ERRFILENOTCREATED, Utils._CalledSub(), 0, , sOutputFile)
+	GoTo Exit_Function
+End Function		'	OutputTo		V1.4.0
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
 '	Return
@@ -905,6 +1003,312 @@ Error_Function:		'	Item by key aborted
 	GoTo Exit_Function
 End Function	'	_hasRecordset	V0.9.5
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputBooleanToHTML(ByVal pbBool As Boolean) As String
+'	Converts input boolean value to HTML compatible string
+
+	_OutputBooleanToHTML = Iif(pbBool, "☑", "☒")
+
+End Function	'	_OutputBooleanToHTML	V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputClassToHTML(ByVal pvArray As variant) As String
+'	Formats classes attribute of <tr> and <td> tags
+
+	If Not IsArray(pvArray) Then
+		_OutputClassToHTML = ""
+	ElseIf UBound(pvArray) < LBound(pvArray) Then
+		_OutputClassToHTML = ""
+	Else
+		_OutputClassToHTML = " class=""" & Join(pvArray, " ") & """"
+	End If
+
+End Function	'	_OutputClassToHTML	V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputDataToHTML(poTable As Object, piFile As Integer) As Boolean
+'	Write html tags around data found in poTable
+'	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 vFieldsSkip() As Variant, iDataType As Integer, iNumRows As Integer, iNumFields As Integer, vDataCell As Variant
+Dim vTrClass() As Variant, vTdClass As Variant, iCountRows As Integer, iLastRow As Integer, iFirstCol As Integer, iLastCol As Integer
+Const cstMaxRows = 200
+	On Local Error GoTo Error_Function
+
+	Print #piFile, "  <table class=""dbdatatable"">"
+	Print #piFile, "   <caption>" & poTable._Name & "</caption>"
+
+	Set oTableRS = poTable.OpenRecordset( , , dbReadOnly)
+	vFieldsSkip() = Array()
+	iNumFields = oTableRS.Fields.Count
+	ReDim vFieldsSkip(0 To iNumFields - 1)
+	With com.sun.star.sdbc.DataType
+		iFirstCol = -1
+		iLastCol = -1
+		For i = 0 To iNumFields - 1
+			iDataType = oTableRS.Fields(i).DataType
+			vFieldsSkip(i) = False
+			If iDataType = .BINARY Or iDataType = .VARBINARY Or iDataType = .LONGVARBINARY Or iDataType = .BLOB Or iDataType = .CLOB Then vFieldsSkip(i) = True
+			If Not vFieldsSkip(i) Then
+				If iFirstCol < 0 Then iFirstCol = i
+				iLastCol = i
+			End If
+		Next i
+	End With
+
+	With oTableRS
+		Print #piFile, "   <thead>"
+		Print #piFile, "    <tr>"
+		For i = 0 To iNumFields - 1
+			If Not vFieldsSkip(i) Then
+				Print #piFile, "     <th scope=""col"">" & .Fields(i)._Name & "</th>"
+			End If
+		Next i
+		Print #piFile, "    </tr>"
+		Print #piFile, "   </thead>"
+		Print #piFile, "   <tfoot>"
+		Print #piFile, "   </tfoot>"
+
+		Print #piFile, "   <tbody>"
+		.MoveLast
+		iLastRow = .RecordCount
+		.MoveFirst
+		iCountRows = 0
+		Do While Not .EOF()
+			vData() = .GetRows(cstMaxRows)
+			iNumRows = UBound(vData, 2) + 1
+			For j = 0 To iNumRows - 1
+				iCountRows = iCountRows + 1
+				vTrClass() = Array()
+				If iCountRows = 1 Then vTrClass() = _AddArray(vTrClass, "firstrow")
+				If iCountRows = iLastRow Then vTrClass() = _AddArray(vTrClass, "lastrow")
+				If (iCountRows Mod 2) = 0 Then vTrClass() = _AddArray(vTrClass, "even") Else vTrClass() = _AddArray(vTrClass, "odd")
+				Print #piFile, "    <tr" & _OutputClassToHTML(vTrClass) & ">"
+				For i = 0 To iNumFields - 1
+					vTdClass() = Array()
+					If i = iFirstCol Then vTdClass() = _AddArray(vTdClass, "firstcol")
+					If i = iLastCol Then vTdClass() = _AddArray(vTdClass, "lastcol")
+					If Not vFieldsSkip(i) Then
+						vDataCell = vData(i, j)
+						Select Case VarType(vDataCell)
+							Case vbEmpty, vbNull
+								vTdClass() = _AddArray(vTdClass, "null")
+								Print #piFile, "     <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputNullToHTML() & "</td>"
+							Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal, vbUShort, vbULong, vbBigInt
+								vTdClass() = _AddArray(vTdClass, "numeric")
+								If vDataCell < 0 Then vTdClass() = _AddArray(vTdClass, "negative")
+								Print #piFile, "     <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputNumberToHTML(vDataCell) & "</td>"
+							Case vbBoolean
+								vTdClass() = _AddArray(vTdClass, "bool")
+								Print #piFile, "     <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputBooleanToHTML(vDataCell) & "</td>"
+							Case vbDate
+								vTdClass() = _AddArray(vTdClass, "date")
+								Print #piFile, "     <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputDateToHTML(vDataCell) & "</td>"
+							Case vbString
+								vTdClass() = _AddArray(vTdClass, "char")
+								Print #piFile, "     <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputStringToHTML(vDataCell) & "</td>"
+							Case Else
+								Print #piFile, "     <td" & _OutputClassToHTML(vTdClass) & ">" & _CStr(vDataCell) & "</td"
+						End Select
+					End If
+				Next i
+				Print #piFile, "    </tr>"
+			Next j
+		Loop
+
+		.mClose()
+	End With
+	Set oTableRS = Nothing
+
+	Print #piFile, "   </tbody>"
+	Print #piFile, "  </table>"
+	_OutputDataToHTML = True
+
+Exit_Function:
+	Exit Function
+Error_Function:
+	TraceError(TRACEWARNING, Err, "_OutputDataToHTML", Erl)
+	_OutputDataToHTML = False
+	Resume Exit_Function
+End Function
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputDateToHTML(ByVal psDate As Date) As String
+'	Converts input date to HTML compatible string
+
+	_OutputDateToHTML = Format(psDate)	'	With regional settings - Ignores time if = to 0
+
+End Function	'	_OutputDateToHTML	V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputNullToHTML() As String
+'	Converts Null value to HTML compatible string
+
+	_OutputNullToHTML = " "
+
+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
+
+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)
+	End If
+	_OutputNumberToHTML = Format(vNumber)
+
+End Function	'	_OutputNumberToHTML	V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputStringToHTML(ByVal psString As String) As String
+'	Converts input string to HTML compatible string
+'	- UTF-8 encoding
+'	- recognition of next patterns
+'		-	" - & - ' - < - >
+'		-	<pre>
+'		-	<a href="...
+'		-	<br>
+'		-	<img src="...
+'		-	<b>, <u>, <i>
+
+Dim vPatterns As Variant
+Dim lCurrentChar as Long, lPattern As Long, lNextPattern As Long, sPattern As String
+Dim sOutput As String, sChar As String
+Dim sUrl As String, lNextQuote As Long, lUrl As Long, bQuote As Boolean, bTagEnd As Boolean
+Dim i As Integer, l As Long
+
+	vPatterns = Array( _
+					""", "&", "'", "<", ">", " " _
+					, "<pre>", "</pre>", "<br>" _
+					, "<a href=""", "</a>", "<img src=""" _
+					, "<b>", "</b>", "<u>", "</u>", "<i>", "</i>" _
+					)
+
+	lCurrentChar = 1
+	sOutput = ""
+	
+	Do While lCurrentChar <= Len(psString)
+		'	Where is next closest pattern ?
+		lPattern = Len(psString) + 1
+		sPattern = ""
+		For i = 0 To UBound(vPatterns)
+			lNextPattern = InStr(lCurrentChar, psString, vPatterns(i), 1)		'	Text (not case-sensitive) string comparison
+			If lNextPattern > 0 And lNextPattern < lPattern Then
+				lPattern = lNextPattern
+				sPattern = Mid(psString, lPattern, Len(vPatterns(i))
+			End If
+		Next i
+		'	Up to the next pattern or to the end of the string, UTF8-encode each character
+		For l = lCurrentChar To lPattern - 1
+			sChar = Mid(psString, l, 1)
+			sOutput = sOutput & Utils._UTF8Encode(sChar)
+		Next l
+		'	Process hyperlink patterns and keep others
+		If Len(sPattern) > 0 Then
+			Select Case LCase(sPattern)
+				Case "<a href=""", "<img src="""
+					'	Up to next quote, url-encode
+					lNextQuote = 0
+					lUrl = lPattern + Len(sPattern)
+					lNextQuote = InStr(lUrl, psString, """", 1)
+					If lNextQuote = 0 Then lNextQuote = Len(psString)			'	Should not happen but, if quoted string not closed ...
+					sUrl = Mid(psString, lUrl, lNextQuote - lUrl)
+					sOutput = sOutput & sPattern & ConvertToUrl(sUrl) & """"
+					lCurrentChar = lNextQuote + 1
+					bQuote = False
+					bTagEnd = False
+					Do
+						sChar = Mid(psString, lCurrentChar, 1)
+						Select Case sChar
+							Case """"
+								bQuote = Not bQuote
+								sOutput = sOutput & sChar
+							Case ">"	'	Tag end if not somewhere between quotes
+								If Not bQuote Then
+									bTagEnd = True
+									sOutput = sOutput & sChar
+								Else
+									sOutput = sOutput & _UTF8Encode(sChar)
+								End If
+							Case Else
+								sOutput = sOutput & _UTF8Encode(sChar)
+						End Select
+						lCurrentChar = lCurrentChar + 1
+						If lCurrentChar > Len(psString) Then bTagEnd = True		'	Should not happen but, if tag not closed ...
+					Loop Until bTagEnd
+				Case Else
+					sOutput = sOutput & sPattern
+					lCurrentChar = lPattern + Len(sPattern)
+			End Select
+		Else
+			lCurrentChar = Len(psString) + 1
+		End If
+	Loop
+	
+	_OutputStringToHTML = sOutput
+
+End Function	'	_OutputStringToHTML 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
+
+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-->"
+Const cstTitleAlt = "<!--AccessTemplate_Title-->", cstBodyAlt = "<!--AccessTemplate_Body-->"
+
+	On Local Error GoTo Error_Function
+	vMinimalTemplate = Array( _
+		"<!DOCTYPE html>" _
+		, "<html>" _
+		, " <head>" _
+		, "  <title>" & cstTitle & "</title>" _
+		, " </head>" _
+		, " <body>" _
+		, "  " & cstBody _
+		, " </body>" _
+		, "</html>" _
+		)
+
+	vTemplate = _ReadFileIntoArray(psTemplateFile)
+	If LBound(vTemplate) > UBound(vTemplate) Then vTemplate() = vMinimalTemplate()
+
+'	Write output file
+	iFile = FreeFile()
+	Open psOutputFile For Output Access Write Lock Read Write As #iFile
+		For i = 0 To UBound(vTemplate)
+			sLine = vTemplate(i)
+			sLine = Join(Split(sLine, cstTitleAlt), cstTitle)
+			sLine = Join(Split(sLine, cstBodyAlt), cstBody)
+			Select Case True
+				Case InStr(sLine, cstTitle) > 0
+					sLine = Join(Split(sLine, cstTitle), poTable._Name)
+					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 Len(sLine) > lBody + Len(cstBody) - 1 Then Print #iFile, Right(sLine, Len(sLine) - lBody + Len(cstBody) + 1)
+				Case Else
+					Print #iFile, sLine
+			End Select
+		Next i
+	Close #iFile
+
+	_OutputToHTML = True
+
+Exit_Function:
+	Exit Function
+Error_Function:
+	_OutputToHTML = False
+	GoTo Exit_Function
+End Function	'	_OutputToHTML	V1.4.0
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Private Function _PropertiesList() As Variant
 

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