summaryrefslogtreecommitdiff
path: root/wizards
diff options
context:
space:
mode:
authorJean-Pierre Ledure <jp@ledure.be>2015-11-11 14:37:29 +0100
committerJean-Pierre Ledure <jp@ledure.be>2015-11-11 14:45:41 +0100
commit32686b0d0a15a653f831d0645e5b7c1145860570 (patch)
treee59bb03c21200010c826daf2e87603c593872488 /wizards
parentc65e00d908a2dcf47d3ff925d09e336d9b0939f7 (diff)
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
Diffstat (limited to 'wizards')
-rw-r--r--wizards/source/access2base/Database.xba404
-rw-r--r--wizards/source/access2base/DoCmd.xba38
-rw-r--r--wizards/source/access2base/Recordset.xba6
-rw-r--r--wizards/source/access2base/Utils.xba58
-rw-r--r--wizards/source/access2base/acConstants.xba11
5 files changed, 502 insertions, 15 deletions
diff --git a/wizards/source/access2base/Database.xba b/wizards/source/access2base/Database.xba
index a8fd3e263e42..4d605d0588c5 100644
--- a/wizards/source/access2base/Database.xba
+++ b/wizards/source/access2base/Database.xba
@@ -582,6 +582,104 @@ Error_NotApplicable:
End Function &apos; 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
+&apos;Supported: acFormatHTML for tables and queries
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = &quot;Database.OutputTo&quot;
+ 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 = &quot;&quot;
+ If Not Utils._CheckArgument(pvOutputFormat, 3, vbString) Then Goto Exit_Function
+ If pvOutputFormat &lt;&gt; &quot;&quot; Then
+ If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array(UCase(acFormatHTML), &quot;HTML&quot;, &quot;&quot;)) _
+ Then Goto Exit_Function &apos; A 2nd time to allow case unsensitivity
+ End If
+ If IsMissing(pvOutputFile) Then pvOutputFile = &quot;&quot;
+ 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 = &quot;&quot;
+ 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
+ &apos;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
+
+ &apos;Determine format and parameters
+ If pvOutputFormat = &quot;&quot; Then
+ sOutputFormat = _PromptFormat() &apos; Prompt user for format
+ If sOutputFormat = &quot;&quot; Then Goto Exit_Function
+ If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array(UCase(acFormatHTML), &quot;HTML&quot;, &quot;&quot;)) _
+ Then Goto Exit_Function &apos; Today only value, later maybe Calc ?
+ Else
+ sOutputFormat = UCase(pvOutputFormat)
+ End If
+
+ &apos;Determine output file
+ If pvOutputFile = &quot;&quot; Then &apos; Prompt file picker to user
+ sOutputFile = _PromptFilePicker(sSuffix)
+ If sOutputFile = &quot;&quot; Then Goto Exit_Function
+ Else
+ sOutputFile = pvOutputFile
+ End If
+ sOutputFile = ConvertToURL(sOutputFile)
+
+ &apos;Create file
+ bOutput = _OutputToHTML(oTable, sOutputFile, pvTemplateFile)
+ Set oTable = Nothing
+
+ &apos;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(&quot;OBJECT&quot;), 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 &apos; OutputTo V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
&apos; Return
&apos; a Collection object if pvIndex absent
@@ -906,6 +1004,312 @@ Error_Function: &apos; Item by key aborted
End Function &apos; _hasRecordset V0.9.5
REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputBooleanToHTML(ByVal pbBool As Boolean) As String
+&apos; Converts input boolean value to HTML compatible string
+
+ _OutputBooleanToHTML = Iif(pbBool, &quot;&amp;#9745;&quot;, &quot;&amp;#9746;&quot;)
+
+End Function &apos; _OutputBooleanToHTML V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputClassToHTML(ByVal pvArray As variant) As String
+&apos; Formats classes attribute of &lt;tr&gt; and &lt;td&gt; tags
+
+ If Not IsArray(pvArray) Then
+ _OutputClassToHTML = &quot;&quot;
+ ElseIf UBound(pvArray) &lt; LBound(pvArray) Then
+ _OutputClassToHTML = &quot;&quot;
+ Else
+ _OutputClassToHTML = &quot; class=&quot;&quot;&quot; &amp; Join(pvArray, &quot; &quot;) &amp; &quot;&quot;&quot;&quot;
+ End If
+
+End Function &apos; _OutputClassToHTML V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputDataToHTML(poTable As Object, piFile As Integer) As Boolean
+&apos; Write html tags around data found in poTable
+&apos; 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, &quot; &lt;table class=&quot;&quot;dbdatatable&quot;&quot;&gt;&quot;
+ Print #piFile, &quot; &lt;caption&gt;&quot; &amp; poTable._Name &amp; &quot;&lt;/caption&gt;&quot;
+
+ 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 &lt; 0 Then iFirstCol = i
+ iLastCol = i
+ End If
+ Next i
+ End With
+
+ With oTableRS
+ Print #piFile, &quot; &lt;thead&gt;&quot;
+ Print #piFile, &quot; &lt;tr&gt;&quot;
+ For i = 0 To iNumFields - 1
+ If Not vFieldsSkip(i) Then
+ Print #piFile, &quot; &lt;th scope=&quot;&quot;col&quot;&quot;&gt;&quot; &amp; .Fields(i)._Name &amp; &quot;&lt;/th&gt;&quot;
+ End If
+ Next i
+ Print #piFile, &quot; &lt;/tr&gt;&quot;
+ Print #piFile, &quot; &lt;/thead&gt;&quot;
+ Print #piFile, &quot; &lt;tfoot&gt;&quot;
+ Print #piFile, &quot; &lt;/tfoot&gt;&quot;
+
+ Print #piFile, &quot; &lt;tbody&gt;&quot;
+ .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, &quot;firstrow&quot;)
+ If iCountRows = iLastRow Then vTrClass() = _AddArray(vTrClass, &quot;lastrow&quot;)
+ If (iCountRows Mod 2) = 0 Then vTrClass() = _AddArray(vTrClass, &quot;even&quot;) Else vTrClass() = _AddArray(vTrClass, &quot;odd&quot;)
+ Print #piFile, &quot; &lt;tr&quot; &amp; _OutputClassToHTML(vTrClass) &amp; &quot;&gt;&quot;
+ For i = 0 To iNumFields - 1
+ vTdClass() = Array()
+ If i = iFirstCol Then vTdClass() = _AddArray(vTdClass, &quot;firstcol&quot;)
+ If i = iLastCol Then vTdClass() = _AddArray(vTdClass, &quot;lastcol&quot;)
+ If Not vFieldsSkip(i) Then
+ vDataCell = vData(i, j)
+ Select Case VarType(vDataCell)
+ Case vbEmpty, vbNull
+ vTdClass() = _AddArray(vTdClass, &quot;null&quot;)
+ Print #piFile, &quot; &lt;td&quot; &amp; _OutputClassToHTML(vTdClass) &amp; &quot;&gt;&quot; &amp; _OutputNullToHTML() &amp; &quot;&lt;/td&gt;&quot;
+ Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal, vbUShort, vbULong, vbBigInt
+ vTdClass() = _AddArray(vTdClass, &quot;numeric&quot;)
+ If vDataCell &lt; 0 Then vTdClass() = _AddArray(vTdClass, &quot;negative&quot;)
+ Print #piFile, &quot; &lt;td&quot; &amp; _OutputClassToHTML(vTdClass) &amp; &quot;&gt;&quot; &amp; _OutputNumberToHTML(vDataCell) &amp; &quot;&lt;/td&gt;&quot;
+ Case vbBoolean
+ vTdClass() = _AddArray(vTdClass, &quot;bool&quot;)
+ Print #piFile, &quot; &lt;td&quot; &amp; _OutputClassToHTML(vTdClass) &amp; &quot;&gt;&quot; &amp; _OutputBooleanToHTML(vDataCell) &amp; &quot;&lt;/td&gt;&quot;
+ Case vbDate
+ vTdClass() = _AddArray(vTdClass, &quot;date&quot;)
+ Print #piFile, &quot; &lt;td&quot; &amp; _OutputClassToHTML(vTdClass) &amp; &quot;&gt;&quot; &amp; _OutputDateToHTML(vDataCell) &amp; &quot;&lt;/td&gt;&quot;
+ Case vbString
+ vTdClass() = _AddArray(vTdClass, &quot;char&quot;)
+ Print #piFile, &quot; &lt;td&quot; &amp; _OutputClassToHTML(vTdClass) &amp; &quot;&gt;&quot; &amp; _OutputStringToHTML(vDataCell) &amp; &quot;&lt;/td&gt;&quot;
+ Case Else
+ Print #piFile, &quot; &lt;td&quot; &amp; _OutputClassToHTML(vTdClass) &amp; &quot;&gt;&quot; &amp; _CStr(vDataCell) &amp; &quot;&lt;/td&quot;
+ End Select
+ End If
+ Next i
+ Print #piFile, &quot; &lt;/tr&gt;&quot;
+ Next j
+ Loop
+
+ .mClose()
+ End With
+ Set oTableRS = Nothing
+
+ Print #piFile, &quot; &lt;/tbody&gt;&quot;
+ Print #piFile, &quot; &lt;/table&gt;&quot;
+ _OutputDataToHTML = True
+
+Exit_Function:
+ Exit Function
+Error_Function:
+ TraceError(TRACEWARNING, Err, &quot;_OutputDataToHTML&quot;, Erl)
+ _OutputDataToHTML = False
+ Resume Exit_Function
+End Function
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputDateToHTML(ByVal psDate As Date) As String
+&apos; Converts input date to HTML compatible string
+
+ _OutputDateToHTML = Format(psDate) &apos; With regional settings - Ignores time if = to 0
+
+End Function &apos; _OutputDateToHTML V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputNullToHTML() As String
+&apos; Converts Null value to HTML compatible string
+
+ _OutputNullToHTML = &quot;&amp;nbsp;&quot;
+
+End Function &apos; _OutputNullToHTML V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputNumberToHTML(ByVal pvNumber As Variant, ByVal Optional piPrecision As Integer) As String
+&apos; 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 &gt;= 0 Then vNumber = (Int(pvNumber * 10 ^ piPrecision + 0.5)) / 10 ^ piPrecision Else vNumber = Int(pvNumber)
+ End If
+ _OutputNumberToHTML = Format(vNumber)
+
+End Function &apos; _OutputNumberToHTML V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputStringToHTML(ByVal psString As String) As String
+&apos; Converts input string to HTML compatible string
+&apos; - UTF-8 encoding
+&apos; - recognition of next patterns
+&apos; - &amp;quot; - &amp;amp; - &amp;apos; - &amp;lt; - &amp;gt;
+&apos; - &lt;pre&gt;
+&apos; - &lt;a href=&quot;...
+&apos; - &lt;br&gt;
+&apos; - &lt;img src=&quot;...
+&apos; - &lt;b&gt;, &lt;u&gt;, &lt;i&gt;
+
+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( _
+ &quot;&amp;quot;&quot;, &quot;&amp;amp;&quot;, &quot;&amp;apos;&quot;, &quot;&amp;lt;&quot;, &quot;&amp;gt;&quot;, &quot;&amp;nbsp;&quot; _
+ , &quot;&lt;pre&gt;&quot;, &quot;&lt;/pre&gt;&quot;, &quot;&lt;br&gt;&quot; _
+ , &quot;&lt;a href=&quot;&quot;&quot;, &quot;&lt;/a&gt;&quot;, &quot;&lt;img src=&quot;&quot;&quot; _
+ , &quot;&lt;b&gt;&quot;, &quot;&lt;/b&gt;&quot;, &quot;&lt;u&gt;&quot;, &quot;&lt;/u&gt;&quot;, &quot;&lt;i&gt;&quot;, &quot;&lt;/i&gt;&quot; _
+ )
+
+ lCurrentChar = 1
+ sOutput = &quot;&quot;
+
+ Do While lCurrentChar &lt;= Len(psString)
+ &apos; Where is next closest pattern ?
+ lPattern = Len(psString) + 1
+ sPattern = &quot;&quot;
+ For i = 0 To UBound(vPatterns)
+ lNextPattern = InStr(lCurrentChar, psString, vPatterns(i), 1) &apos; Text (not case-sensitive) string comparison
+ If lNextPattern &gt; 0 And lNextPattern &lt; lPattern Then
+ lPattern = lNextPattern
+ sPattern = Mid(psString, lPattern, Len(vPatterns(i))
+ End If
+ Next i
+ &apos; 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 &amp; Utils._UTF8Encode(sChar)
+ Next l
+ &apos; Process hyperlink patterns and keep others
+ If Len(sPattern) &gt; 0 Then
+ Select Case LCase(sPattern)
+ Case &quot;&lt;a href=&quot;&quot;&quot;, &quot;&lt;img src=&quot;&quot;&quot;
+ &apos; Up to next quote, url-encode
+ lNextQuote = 0
+ lUrl = lPattern + Len(sPattern)
+ lNextQuote = InStr(lUrl, psString, &quot;&quot;&quot;&quot;, 1)
+ If lNextQuote = 0 Then lNextQuote = Len(psString) &apos; Should not happen but, if quoted string not closed ...
+ sUrl = Mid(psString, lUrl, lNextQuote - lUrl)
+ sOutput = sOutput &amp; sPattern &amp; ConvertToUrl(sUrl) &amp; &quot;&quot;&quot;&quot;
+ lCurrentChar = lNextQuote + 1
+ bQuote = False
+ bTagEnd = False
+ Do
+ sChar = Mid(psString, lCurrentChar, 1)
+ Select Case sChar
+ Case &quot;&quot;&quot;&quot;
+ bQuote = Not bQuote
+ sOutput = sOutput &amp; sChar
+ Case &quot;&gt;&quot; &apos; Tag end if not somewhere between quotes
+ If Not bQuote Then
+ bTagEnd = True
+ sOutput = sOutput &amp; sChar
+ Else
+ sOutput = sOutput &amp; _UTF8Encode(sChar)
+ End If
+ Case Else
+ sOutput = sOutput &amp; _UTF8Encode(sChar)
+ End Select
+ lCurrentChar = lCurrentChar + 1
+ If lCurrentChar &gt; Len(psString) Then bTagEnd = True &apos; Should not happen but, if tag not closed ...
+ Loop Until bTagEnd
+ Case Else
+ sOutput = sOutput &amp; sPattern
+ lCurrentChar = lPattern + Len(sPattern)
+ End Select
+ Else
+ lCurrentChar = Len(psString) + 1
+ End If
+ Loop
+
+ _OutputStringToHTML = sOutput
+
+End Function &apos; _OutputStringToHTML V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _OutputToHTML(poTable As Object, ByVal psOutputFile As String, ByVal psTemplateFile As String) As Boolean
+&apos; 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 = &quot;&lt;!--Template_Title--&gt;&quot;, cstBody = &quot;&lt;!--Template_Body--&gt;&quot;
+Const cstTitleAlt = &quot;&lt;!--AccessTemplate_Title--&gt;&quot;, cstBodyAlt = &quot;&lt;!--AccessTemplate_Body--&gt;&quot;
+
+ On Local Error GoTo Error_Function
+ vMinimalTemplate = Array( _
+ &quot;&lt;!DOCTYPE html&gt;&quot; _
+ , &quot;&lt;html&gt;&quot; _
+ , &quot; &lt;head&gt;&quot; _
+ , &quot; &lt;title&gt;&quot; &amp; cstTitle &amp; &quot;&lt;/title&gt;&quot; _
+ , &quot; &lt;/head&gt;&quot; _
+ , &quot; &lt;body&gt;&quot; _
+ , &quot; &quot; &amp; cstBody _
+ , &quot; &lt;/body&gt;&quot; _
+ , &quot;&lt;/html&gt;&quot; _
+ )
+
+ vTemplate = _ReadFileIntoArray(psTemplateFile)
+ If LBound(vTemplate) &gt; UBound(vTemplate) Then vTemplate() = vMinimalTemplate()
+
+&apos; 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) &gt; 0
+ sLine = Join(Split(sLine, cstTitle), poTable._Name)
+ Print #iFile, sLine
+ Case InStr(sLine, cstBody) &gt; 0
+ lBody = InStr(sLine, cstBody)
+ If lBody &gt; 1 Then Print #iFile, Left(sLine, lBody - 1)
+ _OutputDataToHTML(poTable, iFile)
+ If Len(sLine) &gt; 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 &apos; _OutputToHTML V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant
_PropertiesList = Array(&quot;ObjectType&quot;)
diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index 28e2bc38b944..b5c0e9f22ffa 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/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
&apos;Supported: acFormatPDF, acFormatODT, acFormatDOC, acFormatHTML for forms
+&apos; acFormatHTML for tables and queries
If _ErrorHandler() Then On Local Error Goto Error_Function
- Utils._SetCalledSub(&quot;OutputTo&quot;)
+Const cstThisSub = &quot;OutputTo&quot;
+ 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 = &quot;&quot;
If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
If IsMissing(pvOutputFormat) Then pvOutputFormat = &quot;&quot;
@@ -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 = &quot;&quot;
- If Not Utils._CheckArgument(pvTemplateFile, 6, vbString, &quot;&quot;) Then Goto Exit_Function
- If IsMissing(pvEncoding) Then pvEncoding = &quot;&quot;
- If Not Utils._CheckArgument(pvEncoding, 7, vbString, &quot;&quot;) 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
&apos;Find applicable form
If pvObjectName = &quot;&quot; Then
vWindow = _SelectWindow()
- If vWindow.WindowType &lt;&gt; acSendForm Then Goto Error_Action
+ If vWindow.WindowType &lt;&gt; 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(&quot;OutputTo&quot;)
+ Utils._ResetCalledSub(cstThisSub)
Exit Function
Error_NotFound:
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;OBJECT&quot;), pvObjectName))
@@ -1318,7 +1338,7 @@ Error_Action:
TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0)
Goto Exit_Function
Error_Function:
- TraceError(TRACEABORT, Err, &quot;OutputTo&quot;, Erl)
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
GoTo Exit_Function
Error_File:
TraceError(TRACEFATAL, ERRFILENOTCREATED, Utils._CalledSub(), 0, , sOutputFile)
@@ -2436,7 +2456,7 @@ Const cstComma = &quot;,&quot;
&amp; Iif(psSubject = &quot;&quot;, &quot;&quot;, &quot;subject=&quot; &amp; psSubject &amp; &quot;&amp;&quot;) _
&amp; Iif(psBody = &quot;&quot;, &quot;&quot;, &quot;body=&quot; &amp; psBody &amp; &quot;&amp;&quot;)
If Right(sMailTo, 1) = &quot;&amp;&quot; Or Right(sMailTo, 1) = &quot;?&quot; Then sMailTo = Left(sMailTo, Len(sMailTo) - 1)
- sMailTo = Utils._URLEncode(sMailTo)
+ sMailTo = ConvertToUrl(sMailTo)
oDispatch = createUnoService( &quot;com.sun.star.frame.DispatchHelper&quot;)
oDispatch.executeDispatch(StarDesktop, sMailTo, &quot;&quot;, 0, Array())
diff --git a/wizards/source/access2base/Recordset.xba b/wizards/source/access2base/Recordset.xba
index 28bc2b12e92a..8638e0d9641b 100644
--- a/wizards/source/access2base/Recordset.xba
+++ b/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 &lt; 0 Then Goto Exit_Function
- ReDim vMatrix(0 To pvNumRows - 1, 0 To iNumFields) &apos; Conscious opposite of MSAccess !!
+ ReDim vMatrix(0 To iNumFields, 0 To pvNumRows - 1)
Do While Not _EOF And lSize &lt; 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(&quot;NEXT&quot;)
Loop
If lSize &lt; pvNumRows - 1 Then &apos; 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:
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index 321db78bac67..3a2420e3c22c 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/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
+&apos;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
&apos;Return on top of argument the list of all numeric types
&apos;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 &apos; 0-9, A-Z, a-z
_PercentEncode = psChar
- Case &quot;-&quot;, &quot;.&quot;, &quot;_&quot;, &quot;~&quot;
+ Case Asc(&quot;-&quot;), Asc(&quot;.&quot;), Asc(&quot;_&quot;), Asc(&quot;~&quot;)
_PercentEncode = psChar
- Case &quot;!&quot;, &quot;$&quot;, &quot;&amp;&quot;, &quot;&apos;&quot;, &quot;(&quot;, &quot;)&quot;, &quot;*&quot;, &quot;+&quot;, &quot;,&quot;, &quot;;&quot;, &quot;=&quot; &apos; Reserved characters used as delimitors in query strings
+ Case Asc(&quot;!&quot;), Asc(&quot;$&quot;), Asc(&quot;&amp;&quot;), Asc(&quot;&apos;&quot;), Asc(&quot;(&quot;), Asc(&quot;)&quot;), Asc(&quot;*&quot;), Asc(&quot;+&quot;), Asc(&quot;,&quot;), Asc(&quot;;&quot;), Asc(&quot;=&quot;) &apos; Reserved characters used as delimitors in query strings
_PercentEncode = psChar
- Case &quot; &quot;, &quot;%&quot;
+ Case Asc(&quot; &quot;), Asc(&quot;%&quot;)
_PercentEncode = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(lChar), 2)
Case 0 To 127
_PercentEncode = psChar
@@ -622,6 +634,46 @@ Dim lChar As Long, sByte1 As String, sByte2 As String, sByte3 As String
End Function &apos; _PercentEncode V1.4.0
REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _ReadFileIntoArray(ByVal psFileName) As Variant
+&apos; Loads all lines of a text file into a variant array
+&apos; Any error reduces output to an empty array
+&apos; 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 &apos; +/- the limit of array sizes in Basic
+ On Local Error GoTo Error_Function
+ vLines = Array()
+ _ReadFileIntoArray = Array()
+ If psFileName = &quot;&quot; Then Exit Function
+
+ iFile = FreeFile()
+ Open psFileName For Input Access Read Shared As #iFile
+ iCount1 = 0
+ Do While Not Eof(iFile) And iCount1 &lt; cstMaxLines
+ Line Input #iFile, sLine
+ iCount1 = iCount1 + 1
+ Loop
+ Close #iFile
+
+ ReDim vLines(0 To iCount1 - 1) &apos; 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 &lt; 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 &apos; _ReadFileIntoArray V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _ResetCalledSub(ByVal psSub As String)
&apos; Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling
&apos; Used to trace routine in/outs and to clarify error messages
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index b89e279d2089..3f30ba00f609 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/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 = &quot;writer_pdf_Export&quot;
@@ -282,6 +288,11 @@ Global Const acFormatODT = &quot;writer8&quot;
Global Const acFormatDOC = &quot;MS Word 97&quot;
Global Const acFormatHTML = &quot;HTML&quot;
+REM AcExportQuality
+REM -----------------------------------------------------------------
+Global Const acExportQualityPrint = 0
+Global Const acExportQualityScreen = 1
+
REM AcSysCmdAction
REM -----------------------------------------------------------------
Global Const acSysCmdAccessDir = 9