summaryrefslogtreecommitdiffstats
path: root/wizards/source/access2base/Database.xba
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 16:51:28 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 16:51:28 +0000
commit940b4d1848e8c70ab7642901a68594e8016caffc (patch)
treeeb72f344ee6c3d9b80a7ecc079ea79e9fba8676d /wizards/source/access2base/Database.xba
parentInitial commit. (diff)
downloadlibreoffice-940b4d1848e8c70ab7642901a68594e8016caffc.tar.xz
libreoffice-940b4d1848e8c70ab7642901a68594e8016caffc.zip
Adding upstream version 1:7.0.4.upstream/1%7.0.4upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to '')
-rw-r--r--wizards/source/access2base/Database.xba1884
1 files changed, 1884 insertions, 0 deletions
diff --git a/wizards/source/access2base/Database.xba b/wizards/source/access2base/Database.xba
new file mode 100644
index 000000000..2e361cecf
--- /dev/null
+++ b/wizards/source/access2base/Database.xba
@@ -0,0 +1,1884 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Database" script:language="StarBasic">
+REM =======================================================================================================================
+REM === The Access2Base library is a part of the LibreOffice project. ===
+REM === Full documentation is available on http://www.access2base.com ===
+REM =======================================================================================================================
+
+Option Compatible
+Option ClassModule
+
+Option Explicit
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS ROOT FIELDS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Private _Type As String &apos; Must be DATABASE
+Private _This As Object &apos; Workaround for absence of This builtin function
+Private _Parent As Object
+Private _DbConnect As Integer &apos; DBCONNECTxxx constants
+Private Title As String
+Private Document As Object &apos; com.sun.star.comp.dba.ODatabaseDocument or SwXTextDocument or ScModelObj
+Private Connection As Object &apos; com.sun.star.sdbc.drivers.OConnectionWrapper or com.sun.star.sdbc.XConnection
+Private URL As String
+Private Location As String &apos; Different from URL for registered databases
+Private _ReadOnly As Boolean
+Private MetaData As Object &apos; interface XDatabaseMetaData
+Private _RDBMS As Integer &apos; DBMS constants
+Private _ColumnTypes() As Variant &apos; Part of Metadata.GetTypeInfo()
+Private _ColumnTypeNames() As Variant
+Private _ColumnPrecisions() As Variant
+Private _ColumnTypesReference() As Variant
+Private _ColumnTypesAlias() As Variant &apos; To what should a field whose origin is another DBMS be converted ? See DataTypes By RDBMS.ods
+Private _BinaryStream As Boolean &apos; False = binary fields must NOT be streamed f.i. via ReadAllBytes or WriteAllBytes
+Private Form As Object &apos; com.sun.star.form.XForm
+Private FormName As String
+Private RecordsetMax As Long &apos; To make unique names in Collection below (See bug # 121342)
+Private RecordsetsColl As Object &apos; Collection of active recordsets
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CONSTRUCTORS / DESTRUCTORS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Initialize()
+ _Type = OBJDATABASE
+ Set _This = Nothing
+ Set _Parent = Nothing
+ _DbConnect = 0
+ Title = &quot;&quot;
+ Set Document = Nothing
+ Set Connection = Nothing
+ URL = &quot;&quot;
+ _ReadOnly = False
+ Set MetaData = Nothing
+ _RDBMS = DBMS_UNKNOWN
+ _ColumnTypes = Array()
+ _ColumnTypeNames = Array()
+ _ColumnPrecisions = Array()
+ _ColumnTypesReference = Array()
+ _ColumnTypesAlias() = Array()
+ _BinaryStream = False
+ Set Form = Nothing
+ FormName = &quot;&quot;
+ RecordsetMax = 0
+ Set RecordsetsColl = New Collection
+End Sub &apos; Constructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Terminate()
+ On Local Error Resume Next
+ Call CloseAllRecordsets()
+ If _DbConnect &lt;&gt; DBCONNECTANY Then
+ If Not IsNull(Connection) Then
+ Connection.close()
+ Connection.dispose()
+ Set Connection = Nothing
+ End If
+ Else
+ mClose()
+ End If
+ Call Class_Initialize()
+End Sub &apos; Destructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Sub Dispose()
+ Call Class_Terminate()
+End Sub &apos; Explicit destructor
+
+
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS GET/LET/SET PROPERTIES ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Property Get Connect() As String
+ Connect = _PropertyGet(&quot;Connect&quot;)
+End Property &apos; Connect (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get Name() As String
+ Name = _PropertyGet(&quot;Name&quot;)
+End Property &apos; Name (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get ObjectType() As String
+ ObjectType = _PropertyGet(&quot;ObjectType&quot;)
+End Property &apos; ObjectType (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnCreate() As String
+ OnCreate = _PropertyGet(&quot;OnCreate&quot;)
+End Property &apos; OnCreate (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnFocus() As String
+ OnFocus = _PropertyGet(&quot;OnFocus&quot;)
+End Property &apos; OnFocus (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnLoad() As String
+ OnLoad = _PropertyGet(&quot;OnLoad&quot;)
+End Property &apos; OnLoad (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnLoadFinished() As String
+ OnLoadFinished = _PropertyGet(&quot;OnLoadFinished&quot;)
+End Property &apos; OnLoadFinished (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnModifyChanged() As String
+ OnModifyChanged = _PropertyGet(&quot;OnModifyChanged&quot;)
+End Property &apos; OnModifyChanged (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnNew() As String
+ OnNew = _PropertyGet(&quot;OnNew&quot;)
+End Property &apos; OnNew (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnPrepareUnload() As String
+ OnPrepareUnload = _PropertyGet(&quot;OnPrepareUnload&quot;)
+End Property &apos; OnPrepareUnload (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnPrepareViewClosing() As String
+ OnPrepareViewClosing = _PropertyGet(&quot;OnPrepareViewClosing&quot;)
+End Property &apos; OnPrepareViewClosing (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnSave() As String
+ OnSave = _PropertyGet(&quot;OnSave&quot;)
+End Property &apos; OnSave (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnSaveAs() As String
+ OnSaveAs = _PropertyGet(&quot;OnSaveAs&quot;)
+End Property &apos; OnSaveAs (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnSaveAsDone() As String
+ OnSaveAsDone = _PropertyGet(&quot;OnSaveAsDone&quot;)
+End Property &apos; OnSaveAsDone (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnSaveAsFailed() As String
+ OnSaveAsFailed = _PropertyGet(&quot;OnSaveAsFailed&quot;)
+End Property &apos; OnSaveAsFailed (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnSaveDone() As String
+ OnSaveDone = _PropertyGet(&quot;OnSaveDone&quot;)
+End Property &apos; OnSaveDone (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnSaveFailed() As String
+ OnSaveFailed = _PropertyGet(&quot;OnSaveFailed&quot;)
+End Property &apos; OnSaveFailed (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnSubComponentClosed() As String
+ OnSubComponentClosed = _PropertyGet(&quot;OnSubComponentClosed&quot;)
+End Property &apos; OnSubComponentClosed (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnSubComponentOpened() As String
+ OnSubComponentOpened = _PropertyGet(&quot;OnSubComponentOpened&quot;)
+End Property &apos; OnSubComponentOpened (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnTitleChanged() As String
+ OnTitleChanged = _PropertyGet(&quot;OnTitleChanged&quot;)
+End Property &apos; OnTitleChanged (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnUnfocus() As String
+ OnUnfocus = _PropertyGet(&quot;OnUnfocus&quot;)
+End Property &apos; OnUnfocus (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnUnload() As String
+ OnUnload = _PropertyGet(&quot;OnUnload&quot;)
+End Property &apos; OnUnload (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnViewClosed() As String
+ OnViewClosed = _PropertyGet(&quot;OnViewClosed&quot;)
+End Property &apos; OnViewClosed (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get OnViewCreated() As String
+ OnViewCreated = _PropertyGet(&quot;OnViewCreated&quot;)
+End Property &apos; OnViewCreated (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get Version() As String
+ Version = _PropertyGet(&quot;Version&quot;)
+End Property &apos; Version (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS METHODS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function mClose() As Variant
+&apos; Close the database
+
+If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = &quot;Database.Close&quot;
+ Utils._SetCalledSub(cstThisSub)
+ mClose = False
+ If _DbConnect &lt;&gt; DBCONNECTANY Then Goto Error_NotApplicable
+
+ With Connection
+ If Utils._hasUNOMethod(Connection, &quot;flush&quot;) Then .flush
+ .close()
+ .dispose()
+ End With
+ Set Connection = Nothing
+ mClose = True
+
+Exit_Function:
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Error_NotApplicable:
+ TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
+ Goto Exit_Function
+Error_Function:
+ TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
+ GoTo Exit_Function
+End Function &apos; (m)Close
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Sub CloseAllRecordsets()
+&apos; Clean all recordsets for housekeeping
+
+Dim sRecordsets() As String, i As Integer, oRecordset As Object
+ On Local Error Goto Exit_Sub
+
+ If IsNull(RecordsetsColl) Then Exit Sub
+ If RecordsetsColl.Count &lt; 1 Then Exit Sub
+ For i = 1 To RecordsetsColl.Count
+ Set oRecordset = RecordsetsColl.Item(i)
+ oRecordset.mClose(False) &apos; Do not remove entry in collection
+ Next i
+ Set RecordsetsColl = New Collection
+ RecordsetMax = 0
+
+Exit_Sub:
+ Exit Sub
+End Sub &apos; CloseAllRecordsets V0.9.5
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function CreateQueryDef(ByVal Optional pvQueryName As Variant _
+ , ByVal Optional pvSql As Variant _
+ , ByVal Optional pvOption As Variant _
+ ) As Object
+&apos;Return a (new) QueryDef object based on SQL statement
+Const cstThisSub = &quot;Database.CreateQueryDef&quot;
+ Utils._SetCalledSub(cstThisSub)
+
+Const cstNull = -1
+Dim oQuery As Object, oQueries As Object, i As Integer, sQueryName As String
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+
+ Set CreateQueryDef = Nothing
+ If _DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
+ If IsMissing(pvQueryName) Then Call _TraceArguments()
+ If IsMissing(pvSql) Then Call _TraceArguments()
+ If IsMissing(pvOption) Then pvOption = cstNull
+
+ If Not Utils._CheckArgument(pvQueryName, 1, vbString) Then Goto Exit_Function
+ If pvQueryName = &quot;&quot; Then Call _TraceArguments()
+ If Not Utils._CheckArgument(pvSql, 2, vbString) Then Goto Exit_Function
+ If pvSql = &quot;&quot; Then Call _TraceArguments()
+ If Not Utils._CheckArgument(pvOption, 3, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
+
+ If _ReadOnly Then Goto Error_NoUpdate
+
+ Set oQuery = CreateUnoService(&quot;com.sun.star.sdb.QueryDefinition&quot;)
+ oQuery.rename(pvQueryName)
+ oQuery.Command = _ReplaceSquareBrackets(pvSql)
+ oQuery.EscapeProcessing = Not ( pvOption = dbSQLPassThrough )
+
+ Set oQueries = Document.DataSource.getQueryDefinitions()
+ With oQueries
+ For i = 0 To .getCount() - 1
+ sQueryName = .getByIndex(i).Name
+ If UCase(sQueryName) = UCase(pvQueryName) Then
+ TraceError(TRACEWARNING, ERRQUERYDEFDELETED, Utils._CalledSub(), 0, False, sQueryName)
+ .removeByName(sQueryName)
+ Exit For
+ End If
+ Next i
+ .insertByName(pvQueryName, oQuery)
+ End With
+ Set CreateQueryDef = QueryDefs(pvQueryName)
+
+Exit_Function:
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Error_NotApplicable:
+ TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
+ Goto Exit_Function
+Error_NoUpdate:
+ TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
+ Goto Exit_Function
+Error_Function:
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
+ GoTo Exit_Function
+End Function &apos; CreateQueryDef V1.1.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function CreateTableDef(ByVal Optional pvTableName As Variant) As Object
+&apos;Return a (new/empty) TableDef object
+Const cstThisSub = &quot;Database.CreateTableDef&quot;
+ Utils._SetCalledSub(cstThisSub)
+
+Dim oTable As Object, oTables As Object, sTables() As String
+Dim i As Integer, sTableName As String, oNewTable As Object
+Dim vNameComponents() As Variant, iNames As Integer
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+
+ Set CreateTableDef = Nothing
+ If _DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
+ If IsMissing(pvTableName) Then Call _TraceArguments()
+
+ If Not Utils._CheckArgument(pvTableName, 1, vbString) Then Goto Exit_Function
+ If pvTableName = &quot;&quot; Then Call _TraceArguments()
+
+ If _ReadOnly Then Goto Error_NoUpdate
+
+ Set oTables = Connection.getTables
+ With oTables
+ sTables = .ElementNames()
+ &apos; Check existence of object and find its exact (case-sensitive) name
+ For i = 0 To UBound(sTables)
+ If UCase(pvTableName) = UCase(sTables(i)) Then
+ sTableName = sTables(i)
+ TraceError(TRACEWARNING, ERRTABLEDEFDELETED, Utils._CalledSub(), 0, False, sTableName)
+ .dropByName(sTableName)
+ Exit For
+ End If
+ Next i
+ Set oNewTable = New DataDef
+ Set oNewTable._This = oNewTable
+ oNewTable._Type = OBJTABLEDEF
+ oNewTable._Name = pvTableName
+ vNameComponents = Split(pvTableName, &quot;.&quot;)
+ iNames = UBound(vNameComponents)
+ If iNames &gt;= 2 Then oNewtable.CatalogName = vNameComponents(iNames - 2) Else oNewTable.CatalogName = &quot;&quot;
+ If iNames &gt;= 1 Then oNewtable.SchemaName = vNameComponents(iNames - 1) Else oNewTable.SchemaName = &quot;&quot;
+ oNewtable.TableName = vNameComponents(iNames)
+ Set oNewTable._ParentDatabase = _This
+ Set oNewTable.TableDescriptor = .createDataDescriptor()
+ oNewTable.TableDescriptor.CatalogName = oNewTable.CatalogName
+ oNewTable.TableDescriptor.SchemaName = oNewTable.SchemaName
+ oNewTable.TableDescriptor.Name = oNewTable.TableName
+ oNewTable.TableDescriptor.Type = &quot;TABLE&quot;
+ End With
+
+ Set CreateTabledef = oNewTable
+
+Exit_Function:
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Error_NotApplicable:
+ TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
+ Goto Exit_Function
+Error_NoUpdate:
+ TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
+ Goto Exit_Function
+Error_Function:
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
+ GoTo Exit_Function
+End Function &apos; CreateTableDef V1.1.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DAvg( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ ) As Variant
+&apos; Return average of scope
+Const cstThisSub = &quot;Database.DAvg&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DAvg = _DFunction(&quot;AVG&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DAvg
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DCount( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ ) As Variant
+&apos; Return # of occurrences of scope
+Const cstThisSub = &quot;Database.DCount&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DCount = _DFunction(&quot;COUNT&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DCount
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DLookup( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ , ByVal Optional pvOrderClause As Variant _
+ ) As Variant
+
+&apos; Return a value within a table
+ &apos;Arguments: psExpr: an SQL expression
+ &apos; psDomain: a table- or queryname
+ &apos; pvCriteria: an optional WHERE clause
+ &apos; pcOrderClause: an optional order clause incl. &quot;DESC&quot; if relevant
+ &apos;Return: Value of the psExpr if found, else Null.
+ &apos;Author: inspired from Allen Browne. http://allenbrowne.com/ser-42.html
+ &apos;Examples:
+ &apos; 1. To find the last value, include DESC in the OrderClause, e.g.:
+ &apos; DLookup(&quot;[Surname] &amp; [FirstName]&quot;, &quot;tblClient&quot;, , &quot;ClientID DESC&quot;)
+ &apos; 2. To find the lowest non-null value of a field, use the Criteria, e.g.:
+ &apos; DLookup(&quot;ClientID&quot;, &quot;tblClient&quot;, &quot;Surname Is Not Null&quot; , &quot;Surname&quot;)
+
+Const cstThisSub = &quot;Database.DLookup&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DLookup = _DFunction(&quot;&quot;, psExpr, psDomain _
+ , Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria) _
+ , Iif(IsMissing(pvOrderClause), &quot;&quot;, pvOrderClause) _
+ )
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DLookup
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DMax( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ ) As Variant
+&apos; Return maximum of scope
+Const cstThisSub = &quot;Database.DMax&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DMax = _DFunction(&quot;MAX&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DMax
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DMin( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ ) As Variant
+&apos; Return minimum of scope
+Const cstThisSub = &quot;Database.DMin&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DMin = _DFunction(&quot;MIN&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DMin
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DStDev( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ ) As Variant
+&apos; Return standard deviation of scope
+Const cstThisSub = &quot;Database.DStDev&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DStDev = _DFunction(&quot;STDDEV_SAMP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;) &apos; STDDEV not STDEV !
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DStDev
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DStDevP( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ ) As Variant
+&apos; Return standard deviation of scope
+Const cstThisSub = &quot;Database.DStDevP&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DStDevP = _DFunction(&quot;STDDEV_POP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;) &apos; STDDEV not STDEV !
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DStDevP
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DSum( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ ) As Variant
+&apos; Return sum of scope
+Const cstThisSub = &quot;Database.DSum&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DSum = _DFunction(&quot;SUM&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DSum
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DVar( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ ) As Variant
+&apos; Return variance of scope
+Const cstThisSub = &quot;Database.DVar&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DVar = _DFunction(&quot;VAR_SAMP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DVar
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function DVarP( _
+ ByVal Optional psExpr As String _
+ , ByVal Optional psDomain As String _
+ , ByVal Optional pvCriteria As Variant _
+ ) As Variant
+&apos; Return variance of scope
+Const cstThisSub = &quot;Database.DVarP&quot;
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
+ DVarP = _DFunction(&quot;VAR_POP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
+ Utils._ResetCalledSub(cstThisSub)
+End Function &apos; DVarP
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
+&apos; Return property value of psProperty property name
+
+ Utils._SetCalledSub(&quot;Database.getProperty&quot;)
+ If IsMissing(pvProperty) Then Call _TraceArguments()
+ getProperty = _PropertyGet(pvProperty)
+ Utils._ResetCalledSub(&quot;Database.getProperty&quot;)
+
+End Function &apos; getProperty
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
+&apos; Return True if object has a valid property called pvProperty (case-insensitive comparison !)
+
+ If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
+ Exit Function
+
+End Function &apos; hasProperty
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function OpenRecordset(ByVal Optional pvSource As Variant _
+ , ByVal Optional pvType As Variant _
+ , ByVal Optional pvOptions As Variant _
+ , ByVal Optional pvLockEdit As Variant _
+ ) As Object
+&apos;Return a Recordset object based on Source (= SQL, table or query name)
+
+Const cstThisSub = &quot;Database.OpenRecordset&quot;
+ Utils._SetCalledSub(cstThisSub)
+Const cstNull = -1
+
+Dim lCommandType As Long, sCommand As String, oObject As Object
+Dim sSource As String, i As Integer, iCount As Integer
+Dim sObjects() As String, bFound As Boolean, oTables As Object, oQueries As Object
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+ Set oObject = Nothing
+ If IsMissing(pvSource) Then Call _TraceArguments()
+ If pvSource = &quot;&quot; Then Call _TraceArguments()
+ If IsMissing(pvType) Then
+ pvType = cstNull
+ Else
+ If Not Utils._CheckArgument(pvType, 2, Utils._AddNumeric(), Array(cstNull, dbOpenForwardOnly)) Then Goto Exit_Function
+ End If
+ If IsMissing(pvOptions) Then
+ pvOptions = cstNull
+ Else
+ If Not Utils._CheckArgument(pvOptions, 3, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
+ End If
+ If IsMissing(pvLockEdit) Then
+ pvLockEdit = cstNull
+ Else
+ If Not Utils._CheckArgument(pvLockEdit, 4, Utils._AddNumeric(), Array(cstNull, dbReadOnly)) Then Goto Exit_Function
+ End If
+
+ sSource = Split(UCase(Trim(pvSource)), &quot; &quot;)(0)
+ Select Case True
+ Case sSource = &quot;SELECT&quot;
+ lCommandType = com.sun.star.sdb.CommandType.COMMAND
+ sCommand = _ReplaceSquareBrackets(pvSource)
+ Case Else
+ sSource = UCase(Trim(pvSource))
+ REM Explore tables
+ Set oTables = Connection.getTables
+ sObjects = oTables.ElementNames()
+ bFound = False
+ For i = 0 To UBound(sObjects)
+ If sSource = UCase(sObjects(i)) Then
+ sCommand = sObjects(i)
+ bFound = True
+ Exit For
+ End If
+ Next i
+ If bFound Then
+ lCommandType = com.sun.star.sdb.CommandType.TABLE
+ Else
+ REM Explore queries
+ Set oQueries = Connection.getQueries
+ sObjects = oQueries.ElementNames()
+ For i = 0 To UBound(sObjects)
+ If sSource = UCase(sObjects(i)) Then
+ sCommand = sObjects(i)
+ bFound = True
+ Exit For
+ End If
+ Next i
+ If Not bFound Then Goto Trace_NotFound
+ lCommandType = com.sun.star.sdb.CommandType.QUERY
+ End If
+ End Select
+
+ Set oObject = New Recordset
+ With oObject
+ ._CommandType = lCommandType
+ ._Command = sCommand
+ ._ParentName = Title
+ ._ParentType = _Type
+ ._ForwardOnly = ( pvType = dbOpenForwardOnly )
+ ._PassThrough = ( pvOptions = dbSQLPassThrough )
+ ._ReadOnly = ( (pvLockEdit = dbReadOnly) Or _ReadOnly )
+ Set ._This = oObject
+ Set ._ParentDatabase = _This
+ Call ._Initialize()
+ RecordsetMax = RecordsetMax + 1
+ ._Name = Format(RecordsetMax, &quot;0000000&quot;)
+ RecordsetsColl.Add(oObject, UCase(._Name))
+ End With
+
+ If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() &apos; Do nothing if resultset empty
+
+Exit_Function:
+ Set OpenRecordset = oObject
+ Set oObject = Nothing
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Error_Function:
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
+ GoTo Exit_Function
+Trace_NotFound:
+ TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;TABLE&quot;) &amp; &quot;/&quot; &amp; _GetLabel(&quot;QUERY&quot;), pvSource))
+ Goto Exit_Function
+End Function &apos; OpenRecordset V1.1.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function OpenSQL(Optional ByVal pvSQL As Variant _
+ , Optional ByVal pvOption As Variant _
+ ) As Boolean
+&apos; Return True if the execution of the SQL statement was successful
+&apos; SQL must contain a SELECT query
+&apos; pvOption can force pass through mode
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+
+Const cstThisSub = &quot;Database.OpenSQL&quot;
+ Utils._SetCalledSub(cstThisSub)
+
+ OpenSQL = False
+ If IsMissing(pvSQL) Then Call _TraceArguments()
+ If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function
+Const cstNull = -1
+ If IsMissing(pvOption) Then
+ pvOption = cstNull
+ Else
+ If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), Array(dbSQLPassThrough, cstNull)) Then Goto Exit_Function
+ End If
+ If _DbConnect &lt;&gt; DBCONNECTBASE And _DbConnect &lt;&gt; DBCONNECTFORM Then Goto Error_NotApplicable
+
+Dim oURL As New com.sun.star.util.URL, oDispatch As Object
+Dim vArgs(8) as New com.sun.star.beans.PropertyValue
+
+ oURL.Complete = &quot;.component:DB/DataSourceBrowser&quot;
+ oDispatch = StarDesktop.queryDispatch(oURL, &quot;_Blank&quot;, 8)
+
+ vArgs(0).Name = &quot;ActiveConnection&quot; : vArgs(0).Value = Connection
+ vArgs(1).Name = &quot;CommandType&quot; : vArgs(1).Value = com.sun.star.sdb.CommandType.COMMAND
+ vArgs(2).Name = &quot;Command&quot; : vArgs(2).Value = _ReplaceSquareBrackets(pvSQL)
+ vArgs(3).Name = &quot;ShowMenu&quot; : vArgs(3).Value = True
+ vArgs(4).Name = &quot;ShowTreeView&quot; : vArgs(4).Value = False
+ vArgs(5).Name = &quot;ShowTreeViewButton&quot; : vArgs(5).Value = False
+ vArgs(6).Name = &quot;Filter&quot; : vArgs(6).Value = &quot;&quot;
+ vArgs(7).Name = &quot;ApplyFilter&quot; : vArgs(7).Value = False
+ vArgs(8).Name = &quot;EscapeProcessing&quot; : vArgs(8).Value = CBool(Not ( pvOption = dbSQLPassThrough ))
+
+ oDispatch.dispatch(oURL, vArgs)
+ OpenSQL = True
+
+Exit_Function:
+ Exit Function
+Error_Function:
+ TraceError(TRACEABORT, Err, &quot;OpenSQL&quot;, Erl)
+ GoTo Exit_Function
+SQL_Error:
+ TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , pvSQL)
+ Goto Exit_Function
+Error_NotApplicable:
+ TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
+ Goto Exit_Function
+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 _
+ , ByRef Optional pvHeaders As Variant _
+ , ByRef Optional pvData As Variant _
+ ) As Boolean
+&apos;Supported: acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT for tables and queries
+&apos;pvHeaders and pvData (unpublished) when pvObjectType = acOutputArray
+
+ 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, 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 = &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; _
+ , UCase(acFormatODS), &quot;ODS&quot; _
+ , UCase(acFormatXLS), &quot;XLS&quot; _
+ , UCase(acFormatXLSX), &quot;XLSX&quot; _
+ , UCase(acFormatTXT), &quot;TXT&quot;, &quot;CSV&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()) 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 = &quot;HTML&quot;
+ 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
+
+ If pvObjectType = acOutputArray Then
+ Set oTable = Nothing
+ Else
+ &apos;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
+
+ &apos;Determine format and parameters
+ If pvOutputFormat = &quot;&quot; Then
+ sOutputFormat = _PromptFormat(Array(&quot;HTML&quot;, &quot;ODS&quot;, &quot;XLS&quot;, &quot;XLSX&quot;, &quot;TXT&quot;)) &apos; Prompt user for format
+ If sOutputFormat = &quot;&quot; Then Goto Exit_Function
+ Else
+ sOutputFormat = UCase(pvOutputFormat)
+ End If
+
+ &apos;Determine output file
+ If pvOutputFile = &quot;&quot; Then &apos; Prompt file picker to user
+ Select Case sOutputFormat
+ Case UCase(acFormatHTML), &quot;HTML&quot; : sSuffix = &quot;html&quot;
+ Case UCase(acFormatODS), &quot;ODS&quot; : sSuffix = &quot;ods&quot;
+ Case UCase(acFormatXLS), &quot;XLS&quot; : sSuffix = &quot;xls&quot;
+ Case UCase(acFormatXLSX), &quot;XLSX&quot; : sSuffix = &quot;xlsx&quot;
+ Case UCase(acFormatTXT), &quot;TXT&quot;, &quot;CSV&quot; : sSuffix = &quot;txt&quot;
+ End Select
+ sOutputFile = _PromptFilePicker(sSuffix)
+ If sOutputFile = &quot;&quot; Then Goto Exit_Function
+ Else
+ sOutputFile = pvOutputFile
+ End If
+ sOutputFile = ConvertToURL(sOutputFile)
+
+ &apos;Create file
+ Select Case sOutputFormat
+ Case UCase(acFormatHTML), &quot;HTML&quot;
+ If pvObjectType = acOutputArray Then
+ bOutput = _OutputToHTML(Nothing, pvObjectName, sOutputFile, pvTemplateFile, pvHeaders, pvData)
+ Else
+ bOutput = _OutputToHTML(oTable, pvObjectName, sOutputFile, pvTemplateFile)
+ End If
+ Case UCase(acFormatODS), &quot;ODS&quot;
+ bOutput = _OutputToCalc(oTable, sOutputFile, acFormatODS)
+ Case UCase(acFormatXLS), &quot;XLS&quot;
+ bOutput = _OutputToCalc(oTable, sOutputFile, acFormatXLS)
+ Case UCase(acFormatXLS), &quot;XLSX&quot;
+ bOutput = _OutputToCalc(oTable, sOutputFile, acFormatXLSX)
+ Case UCase(acFormatTXT), &quot;TXT&quot;, &quot;CSV&quot;
+ bOutput = _OutputToCalc(oTable, sOutputFile, acFormatTXT, pvEncoding)
+ End Select
+
+ &apos;Launch application, if requested
+ If bOutput Then
+ If pvAutoStart Then Call _ShellExecute(sOutputFile)
+ Else
+ GoTo Error_File
+ End If
+
+ OutputTo = True
+
+Exit_Function:
+ If Not IsNull(oTable) Then
+ oTable.Dispose()
+ Set oTable = Nothing
+ End If
+ 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
+&apos; a Property object otherwise
+
+ Utils._SetCalledSub(&quot;Database.Properties&quot;)
+Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
+ vPropertiesList = _PropertiesList()
+ sObject = Utils._PCase(_Type)
+ If IsMissing(pvIndex) Then
+ vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
+ Else
+ vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
+ vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
+ End If
+ Set vProperty._ParentDatabase = _This
+
+Exit_Function:
+ Set Properties = vProperty
+ Utils._ResetCalledSub(&quot;Database.Properties&quot;)
+ Exit Function
+End Function &apos; Properties
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function QueryDefs(ByVal Optional pvIndex As Variant, ByVal Optional pbCheck As Boolean) As Object
+&apos; Collect all Queries in the database
+&apos; pbCheck unpublished
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+ Utils._SetCalledSub(&quot;Database.QueryDefs&quot;)
+ If IsMissing(pbCheck) Then pbCheck = False
+
+Dim sObjects() As String, sObjectName As String, oObject As Object
+Dim i As Integer, bFound As Boolean, oQueries As Object
+ Set oObject = Nothing
+ If Not IsMissing(pvIndex) Then
+ If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
+ End If
+
+ Set oQueries = Connection.getQueries
+ sObjects = oQueries.ElementNames()
+ Select Case True
+ Case IsMissing(pvIndex)
+ Set oObject = New Collect
+ Set oObject._This = oObject
+ oObject._CollType = COLLQUERYDEFS
+ Set oObject._Parent = _This
+ oObject._Count = UBound(sObjects) + 1
+ Goto Exit_Function
+ Case VarType(pvIndex) = vbString
+ bFound = False
+ &apos; Check existence of object and find its exact (case-sensitive) name
+ For i = 0 To UBound(sObjects)
+ If UCase(pvIndex) = UCase(sObjects(i)) Then
+ sObjectName = sObjects(i)
+ bFound = True
+ Exit For
+ End If
+ Next i
+ If Not bFound Then Goto Trace_NotFound
+ Case Else &apos; pvIndex is numeric
+ If pvIndex &lt; 0 Or pvIndex &gt; UBound(sObjects) Then Goto Trace_IndexError
+ sObjectName = sObjects(pvIndex)
+ End Select
+
+ Set oObject = New DataDef
+ Set oObject._This = oObject
+ oObject._Type = OBJQUERYDEF
+ oObject._Name = sObjectName
+ Set oObject._ParentDatabase = _This
+ oObject._readOnly = _ReadOnly
+ Set oObject.Query = oQueries.getByName(sObjectName)
+
+Exit_Function:
+ Set QueryDefs = oObject
+ Set oObject = Nothing
+ Utils._ResetCalledSub(&quot;Database.QueryDefs&quot;)
+ Exit Function
+Error_Function:
+ TraceError(TRACEABORT, Err, &quot;Database.QueryDefs&quot;, Erl)
+ GoTo Exit_Function
+Trace_NotFound:
+ If Not pbCheck Then TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;QUERY&quot;), pvIndex))
+ Goto Exit_Function
+Trace_IndexError:
+ TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
+ Goto Exit_Function
+End Function &apos; QueryDefs V1.1.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Recordsets(ByVal Optional pvIndex As Variant) As Object
+&apos; Collect all active recordsets
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+ Utils._SetCalledSub(&quot;Database.Recordsets&quot;)
+
+ Set Recordsets = Nothing
+ If Not IsMissing(pvIndex) Then
+ If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
+ End If
+
+Dim sObjects() As String, sObjectName As String, oObject As Object
+Dim i As Integer, bFound As Boolean, oTables As Object
+
+ Select Case True
+ Case IsMissing(pvIndex)
+ Set oObject = New Collect
+ Set oObject._This = oObject
+ oObject._CollType = COLLRECORDSETS
+ Set oObject._Parent = _This
+ oObject._Count = RecordsetsColl.Count
+ Case VarType(pvIndex) = vbString
+ bFound = _hasRecordset(pvIndex)
+ If Not bFound Then Goto Trace_NotFound
+ Set oObject = RecordsetsColl.Item(pvIndex)
+ Case Else &apos; pvIndex is numeric
+ If pvIndex &lt; 0 Or pvIndex &gt;= RecordsetsColl.Count Then Goto Trace_IndexError
+ Set oObject = RecordsetsColl.Item(pvIndex + 1) &apos; Collection members are numbered 1 ... Count
+ End Select
+
+Exit_Function:
+ Set Recordsets = oObject
+ Set oObject = Nothing
+ Utils._ResetCalledSub(&quot;Database.Recordsets&quot;)
+ Exit Function
+Error_Function:
+ TraceError(TRACEABORT, Err, &quot;Database.Recordsets&quot;, Erl)
+ GoTo Exit_Function
+Trace_NotFound:
+ TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;RECORDSET&quot;), pvIndex))
+ Goto Exit_Function
+Trace_IndexError:
+ TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
+ Goto Exit_Function
+End Function &apos; Recordsets V0.9.5
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function RunSQL(Optional ByVal pvSQL As Variant _
+ , Optional ByVal pvOption As Variant _
+ ) As Boolean
+&apos; Return True if the execution of the SQL statement was successful
+&apos; SQL must contain an ACTION query
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+
+Const cstThisSub = &quot;Database.RunSQL&quot;
+ Utils._SetCalledSub(cstThisSub)
+
+ RunSQL = False
+ If IsMissing(pvSQL) Then Call _TraceArguments()
+ If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function
+Const cstNull = -1
+ If IsMissing(pvOption) Then
+ pvOption = cstNull
+ Else
+ If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
+ End If
+
+Dim oStatement As Object, vResult As Variant
+ Set oStatement = Connection.createStatement()
+ oStatement.EscapeProcessing = Not ( pvOption = dbSQLPassThrough )
+ On Local Error Goto SQL_Error
+ vResult = oStatement.execute(_ReplaceSquareBrackets(pvSQL))
+ On Local Error Goto Error_Function
+ RunSQL = True
+
+Exit_Function:
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Error_Function:
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
+ GoTo Exit_Function
+SQL_Error:
+ TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , pvSQL)
+ Goto Exit_Function
+End Function &apos; RunSQL V1.1.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function TableDefs(ByVal Optional pvIndex As Variant, ByVal Optional pbCheck As Boolean) As Object
+&apos; Collect all tables in the database
+&apos; pbCheck unpublished
+
+Const cstThisSub = &quot;Database.TableDefs&quot;
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+ Utils._SetCalledSub(cstThisSub)
+ If IsMissing(pbCheck) Then pbCheck = False
+
+Dim sObjects() As String, sObjectName As String, oObject As Object
+Dim i As Integer, bFound As Boolean, oTables As Object
+ Set oObject = Nothing
+ If Not IsMissing(pvIndex) Then
+ If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
+ End If
+
+ Set oTables = Connection.getTables
+ sObjects = oTables.ElementNames()
+ Select Case True
+ Case IsMissing(pvIndex)
+ Set oObject = New Collect
+ Set oObject._This = oObject
+ oObject._CollType = COLLTABLEDEFS
+ Set oObject._Parent = _This
+ oObject._Count = UBound(sObjects) + 1
+ Goto Exit_Function
+ Case VarType(pvIndex) = vbString
+ bFound = False
+ &apos; Check existence of object and find its exact (case-sensitive) name
+ For i = 0 To UBound(sObjects)
+ If UCase(pvIndex) = UCase(sObjects(i)) Then
+ sObjectName = sObjects(i)
+ bFound = True
+ Exit For
+ End If
+ Next i
+ If Not bFound Then Goto Trace_NotFound
+ Case Else &apos; pvIndex is numeric
+ If pvIndex &lt; 0 Or pvIndex &gt; UBound(sObjects) Then Goto Trace_IndexError
+ sObjectName = sObjects(pvIndex)
+ End Select
+
+ Set oObject = New DataDef
+ With oObject
+ ._This = oObject
+ ._Type = OBJTABLEDEF
+ ._Name = sObjectName
+ Set ._ParentDatabase = _This
+ ._ReadOnly = _ReadOnly
+ Set .Table = oTables.getByName(sObjectName)
+ .CatalogName = .Table.CatalogName
+ .SchemaName = .Table.SchemaName
+ .TableName = .Table.Name
+ End With
+
+Exit_Function:
+ Set TableDefs = oObject
+ Set oObject = Nothing
+ Utils._ResetCalledSub(cstThisSub)
+ Exit Function
+Error_Function:
+ TraceError(TRACEABORT, Err, cstThisSub, Erl)
+ GoTo Exit_Function
+Trace_NotFound:
+ If Not pbCheck Then TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;TABLE&quot;), pvIndex))
+ Goto Exit_Function
+Trace_IndexError:
+ TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
+ Goto Exit_Function
+End Function &apos; TableDefs V1.1.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- PRIVATE FUNCTIONS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _DFunction(ByVal psFunction As String _
+ , ByVal psExpr As String _
+ , ByVal psDomain As String _
+ , ByVal pvCriteria As Variant _
+ , ByVal Optional pvOrderClause As Variant _
+ ) As Variant
+ &apos;Arguments: psFunction an optional aggregate function
+ &apos; psExpr: an SQL expression [might contain an aggregate function]
+ &apos; psDomain: a table- or queryname
+ &apos; pvCriteria: an optional WHERE clause
+ &apos; pcOrderClause: an optional order clause incl. &quot;DESC&quot; if relevant
+
+If _ErrorHandler() Then On Local Error GoTo Error_Function
+
+Dim oResult As Object &apos;To retrieve the value to find.
+Dim vResult As Variant &apos;Return value for function.
+Dim sSql As String &apos;SQL statement.
+Dim oStatement As Object &apos;For CreateStatement method
+Dim sExpr As String &apos;For inclusion of aggregate function
+Dim sTempField As String &apos;Random temporary field in SQL expression
+
+Dim sTarget as String, sWhere As String, sOrderBy As String, sLimit As String
+Dim sProductName As String
+
+ vResult = Null
+
+ Randomize 2^14-1
+ sTempField = &quot;[TEMP&quot; &amp; Right(&quot;00000&quot; &amp; Int(100000 * Rnd), 5) &amp; &quot;]&quot;
+ If pvCriteria &lt;&gt; &quot;&quot; Then sWhere = &quot; WHERE &quot; &amp; pvCriteria Else sWhere = &quot;&quot;
+ If pvOrderClause &lt;&gt; &quot;&quot; Then sOrderBy = &quot; ORDER BY &quot; &amp; pvOrderClause Else sOrderBy = &quot;&quot;
+ sLimit = &quot;&quot;
+
+&apos; Workaround for https://bugs.documentfoundation.org/show_bug.cgi?id=118767
+&apos; awaiting solution for https://bugs.documentfoundation.org/show_bug.cgi?id=118809
+ sProductName = UCase(MetaData.getDatabaseProductName())
+ If sProductName = &quot;&quot; Then
+ If MetaData.URL = &quot;sdbc:embedded:firebird&quot; Or Left(MetaData.URL, 13) = &quot;sdbc:firebird&quot; Then sProductName = &quot;FIREBIRD&quot;
+ End If
+
+ Select Case sProductName
+ Case &quot;MYSQL&quot;, &quot;SQLITE&quot;
+ If psFunction = &quot;&quot; Then
+ sTarget = psExpr
+ sLimit = &quot; LIMIT 1&quot;
+ Else
+ sTarget = UCase(psFunction) &amp; &quot;(&quot; &amp; psExpr &amp; &quot;)&quot;
+ End If
+ sSql = &quot;SELECT &quot; &amp; sTarget &amp; &quot; AS &quot; &amp; sTempField &amp; &quot; FROM &quot; &amp; psDomain &amp; sWhere &amp; sOrderBy &amp; sLimit
+ Case &quot;FIREBIRD&quot;
+ If psFunction = &quot;&quot; Then sTarget = &quot;FIRST 1 &quot; &amp; psExpr Else sTarget = UCase(psFunction) &amp; &quot;(&quot; &amp; psExpr &amp; &quot;)&quot;
+ sSql = &quot;SELECT &quot; &amp; sTarget &amp; &quot; AS &quot; &amp; sTempField &amp; &quot; FROM &quot; &amp; psDomain &amp; sWhere &amp; sOrderBy
+ Case Else &apos; Standard syntax - Includes HSQLDB
+ If psFunction = &quot;&quot; Then sTarget = &quot;TOP 1 &quot; &amp; psExpr Else sTarget = UCase(psFunction) &amp; &quot;(&quot; &amp; psExpr &amp; &quot;)&quot;
+ sSql = &quot;SELECT &quot; &amp; sTarget &amp; &quot; AS &quot; &amp; sTempField &amp; &quot; FROM &quot; &amp; psDomain &amp; sWhere &amp; sOrderBy
+ End Select
+
+ &apos;Lookup the value.
+ Set oStatement = Connection.createStatement()
+ With oStatement
+ .ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY
+ .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY
+ .EscapeProcessing = False
+ sSql = _ReplaceSquareBrackets(sSql) &apos;Substitute [] by quote string
+ Set oResult = .executeQuery(sSql)
+ If Not IsNull(oResult) And Not IsEmpty(oResult) Then
+ If Not oResult.next() Then Goto Exit_Function
+ vResult = Utils._getResultSetColumnValue(oResult, 1, True) &apos; Force return of binary field
+ End If
+ End With
+
+Exit_Function:
+ &apos;Assign the returned value.
+ _DFunction = vResult
+ Set oResult = Nothing
+ Set oStatement = Nothing
+ Exit Function
+Error_Function:
+ TraceError(TRACEFATAL, ERRDFUNCTION, _A2B_.CalledSub, 0, , sSQL)
+ Goto Exit_Function
+End Function &apos; DFunction V1.5.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _FilterOptionsDefault(ByVal plEncoding As Long) As String
+&apos; Return the default FilterOptions string for table/query export to csv
+
+Dim sFieldSeparator as string
+Const cstComma = &quot;,&quot;
+Const cstTextDelimitor = &quot;&quot;&quot;&quot;
+
+ If _DecimalPoint() = &quot;,&quot; Then sFieldSeparator = &quot;;&quot; Else sFieldSeparator = cstComma
+ _FilteroptionsDefault = Trim(Str(Asc(sFieldSeparator))) _
+ &amp; cstComma &amp; Trim(Str(Asc(cstTextDelimitor))) _
+ &amp; cstComma &amp; Trim(Str(plEncoding)) _
+ &amp; cstComma &amp; &quot;1&quot;
+
+End Function &apos; _FilterOptionsDefault V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _hasRecordset(ByVal psName As String) As Boolean
+&apos; Return True if psName if in the collection of Recordsets
+
+Dim oRecordset As Object
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+ Set oRecordset = RecordsetsColl.Item(psName)
+ _hasRecordset = True
+
+Exit_Function:
+ Exit Function
+Error_Function: &apos; Item by key aborted
+ _hasRecordset = False
+ GoTo Exit_Function
+End Function &apos; _hasRecordset V0.9.5
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub _LoadMetadata()
+&apos; Load essentially getTypeInfo() results from Metadata
+
+Dim sProduct As String
+Dim iInfo As Integer, oTypeInfo As Object, sName As String, lType As Integer
+
+Const cstMaxInfo = 40
+ ReDim _ColumnTypes(0 To cstMaxInfo)
+ ReDim _ColumnTypeNames(0 To cstMaxInfo)
+ ReDim _ColumnPrecisions(0 To cstMaxInfo)
+Const cstHSQLDB1 = &quot;HSQL Database Engine 1.&quot;
+Const cstHSQLDB2 = &quot;HSQL Database Engine 2.&quot;
+Const cstFirebird = &quot;sdbc:embedded:firebird&quot;
+Const cstMSAccess2003 = &quot;MS Jet 0&quot;
+Const cstMSAccess2007 = &quot;MS Jet 04.&quot;
+Const cstMYSQL = &quot;MySQL&quot;
+Const cstPOSTGRES = &quot;PostgreSQL&quot;
+Const cstSQLITE = &quot;SQLite&quot;
+
+ With com.sun.star.sdbc.DataType
+ _ColumnTypesReference = Array( _
+ .ARRAY _
+ , .BIGINT _
+ , .BINARY _
+ , .BIT _
+ , .BLOB _
+ , .BOOLEAN _
+ , .CHAR _
+ , .CLOB _
+ , .DATE _
+ , .DECIMAL _
+ , .DISTINCT _
+ , .DOUBLE _
+ , .FLOAT _
+ , .INTEGER _
+ , .LONGVARBINARY _
+ , .LONGVARCHAR _
+ , .NUMERIC _
+ , .OBJECT _
+ , .OTHER _
+ , .REAL _
+ , .REF _
+ , .SMALLINT _
+ , .SQLNULL _
+ , .STRUCT _
+ , .TIME _
+ , .TIMESTAMP _
+ , .TINYINT _
+ , .VARBINARY _
+ , .VARCHAR _
+ )
+ End With
+
+ With Metadata
+ sProduct = .getDatabaseProductName() &amp; &quot; &quot; &amp; .getDatabaseProductVersion
+ Select Case True
+ Case Len(sProduct) &gt; Len(cstHSQLDB1) And Left(sProduct, Len(cstHSQLDB1)) = cstHSQLDB1
+ _RDBMS = DBMS_HSQLDB1
+ _ColumnTypesAlias = Array(0, -5, -2, 16, -4, 16, 1, -1, 91, 3, 0, 8, 6, 4, -4, -1, 2, 0, 0, 7, 0, 5, 0, 0, 92, 93, -6, -3, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstHSQLDB2) And Left(sProduct, Len(cstHSQLDB2)) = cstHSQLDB2
+ _RDBMS = DBMS_HSQLDB2
+ _ColumnTypesAlias = Array(0, -5, -3, -7, 2004, 16, 1, 2005, 91, 3, 0, 8, 8, 4, -3, 12, 2, 0, 0, 8, 0, 5, 0, 0, 92, 93, -6, -3, 12)
+ _BinaryStream = True
+ Case .URL = cstFirebird &apos; Only embedded 3.0
+ _RDBMS = DBMS_FIREBIRD
+ _ColumnTypesAlias = Array(0, -5, -2, 16, 2004, 16, 1, 2005, 91, 3, 0, 8, 6, 4, -4, 2005, 2, 0, 0, 8, 0, 5, 0, 0, 92, 93, 4, 2004, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstMSAccess2007) And Left(sProduct, Len(cstMSAccess2007)) = cstMSAccess2007
+ _RDBMS = DBMS_MSACCESS2007
+ _ColumnTypesAlias = Array(0, 4, -2, 16, -2, 16, 12, 12, 93, 8, 0, 8, 6, 4, -3, 12, 2, 0, 0, 8, 0, 5, 0, 0, 93, 93, -6, -2, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstMSAccess2003) And Left(sProduct, Len(cstMSAccess2003)) = cstMSAccess2003
+ _RDBMS = DBMS_MSACCESS2003
+ _ColumnTypesAlias = Array(0, 4, -2, 16, -2, 16, 12, 12, 93, 8, 0, 8, 6, 4, -3, 12, 2, 0, 0, 8, 0, 5, 0, 0, 93, 93, -6, -2, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstMYSQL) And Left(sProduct, Len(cstMYSQL)) = cstMYSQL
+ _RDBMS = DBMS_MYSQL
+ _ColumnTypesAlias = Array(0, -5, -2, -7, -4, -7, 1, -1, 91, 3, 0, 8, 8, 4, -4, -1, 2, 0, 0, 7, 0, 5, 0, 0, 92, 93, -6, -3, -1)
+ _BinaryStream = False
+ Case Len(sProduct) &gt; Len(cstPOSTGRES) And Left(sProduct, Len(cstPOSTGRES)) = cstPOSTGRES
+ _RDBMS = DBMS_POSTGRES
+ _ColumnTypesAlias = Array(0, -5, -3, 16, -3, 16, 1, 12, 91, 8, 0, 8, 8, 4, -3, 12, 2, 0, 0, 7, 0, 5, 0, 0, 92, 93, 4, -3, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstSQLITE) And Left(sProduct, Len(cstSQLITE)) = cstSQLITE
+ _RDBMS = DBMS_SQLITE
+ _ColumnTypesAlias = Array(0, -5, -4, -7, -4, -7, 1, -1, 91, 8, 0, 8, 6, 4, -4, -1, 8, 0, 0, 8, 0, 5, 0, 0, 92, 93, -6, -4, 12)
+ _BinaryStream = True
+ Case Else
+ _RDBMS = DBMS_UNKNOWN
+ _BinaryStream = True
+ End Select
+
+ iInfo = -1
+ Set oTypeInfo = MetaData.getTypeInfo()
+ With oTypeInfo
+ .next()
+ Do While Not .isAfterLast() And iInfo &lt; cstMaxInfo
+ sName = .getString(1)
+ lType = .getLong(2)
+ If _RDBMS = DBMS_POSTGRES And (Left(sName, 1) &lt;&gt; &quot;_&quot; Or lType &lt;&gt; -1) Then &apos; Skip
+ Else
+ iInfo = iInfo + 1
+ _ColumnTypeNames(iInfo) = sName
+ _ColumnTypes(iInfo) = lType
+ _ColumnPrecisions(iInfo) = CLng(.getLong(3))
+ End If
+ .next()
+ Loop
+ End With
+ ReDim Preserve _ColumnTypes(0 To iInfo)
+ ReDim Preserve _ColumnTypeNames(0 To iInfo)
+ ReDim Preserve _ColumnPrecisions(0 To iInfo)
+ End With
+
+End Sub &apos; _LoadMetadata V1.6.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputBinaryToHTML() As String
+&apos; Converts Binary value to HTML compatible string
+
+ _OutputBinaryToHTML = &quot;&amp;nbsp;&quot;
+
+End Function &apos; _OutputBinaryToHTML V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputBooleanToHTML(ByVal pbBool As Boolean) As String
+&apos; Converts input boolean value to HTML compatible string
+
+ _OutputBooleanToHTML = Iif(pbBool, &quot;&amp;#x2714;&quot;, &quot;&amp;#x2716;&quot;) &apos; ✔ and ✖
+
+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(ByRef pvTable As Variant, ByVal pvName As String, ByVal piFile As Integer _
+ , ByRef Optional pvHeaders As Variant _
+ , ByRef Optional pvData As Variant _
+ ) As Boolean
+&apos; Write html tags around data found in pvTable
+&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 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, &quot; &lt;table class=&quot;&quot;dbdatatable&quot;&quot;&gt;&quot;
+ Print #piFile, &quot; &lt;caption&gt;&quot; &amp; pvName &amp; &quot;&lt;/caption&gt;&quot;
+
+ vFieldsBin() = Array()
+ If bDataArray Then
+ Set oTableRS = Nothing
+ iNumFields = UBound(pvHeaders) + 1
+ ReDim vFieldsBin(0 To iNumFields - 1)
+ For i = 0 To iNumFields - 1
+ vFieldsBin(i) = False
+ Next i
+ 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, &quot; &lt;thead&gt;&quot;
+ Print #piFile, &quot; &lt;tr&gt;&quot;
+ For i = 0 To iNumFields - 1
+ If bDataArray Then sHeader = pvHeaders(i) Else sHeader = .Fields(i)._Name
+ Print #piFile, &quot; &lt;th scope=&quot;&quot;col&quot;&quot;&gt;&quot; &amp; sHeader &amp; &quot;&lt;/th&gt;&quot;
+ 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;
+ If bDataArray Then
+ iLastRow = UBound(pvData, 2) + 1
+ Else
+ .MoveLast
+ iLastRow = .RecordCount
+ .MoveFirst
+ End If
+ iCountRows = 0
+ Do While iCountRows &lt; iLastRow
+ If bDataArray Then
+ iNumRows = iLastRow
+ Else
+ vData() = .GetRows(cstMaxRows)
+ iNumRows = UBound(vData, 2) + 1
+ End If
+ 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 = 0 Then vTdClass() = _AddArray(vTdClass, &quot;firstcol&quot;)
+ If i = iNumFields - 1 Then vTdClass() = _AddArray(vTdClass, &quot;lastcol&quot;)
+ If Not vFieldsBin(i) Then
+ If bDataArray Then vDataCell = pvData(i, j) Else vDataCell = vData(i, j)
+ If vDataCell Is Nothing Then vDataCell = Null &apos; Necessary because Null object has not a VarType = vbNull
+ If VarType(vDataCell) = vbString Then &apos; Null string gives IsDate = True !
+ If Len(vDataCell) &gt; 0 And IsDate(vDataCell) Then vDataCell = CDate(vDataCell)
+ End If
+ 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;)
+ If vDataCell = False Then vTdClass() = _AddArray(vTdClass, &quot;false&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&gt;&quot;
+ End Select
+ Else &apos; Binary fields
+ Print #piFile, &quot; &lt;td&quot; &amp; _OutputClassToHTML(vTdClass) &amp; &quot;&gt;&quot; &amp; _OutputBinaryToHTML() &amp; &quot;&lt;/td&gt;&quot;
+ End If
+ Next i
+ Print #piFile, &quot; &lt;/tr&gt;&quot;
+ Next j
+ Loop
+
+ If Not bDataArray Then .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 &apos; _OutputDataToHTML V1.4.0
+
+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 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 &gt;= 0 Then vNumber = (Int(pvNumber * 10 ^ piPrecision + 0.5)) / 10 ^ piPrecision Else vNumber = 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 id=&quot;&quot;&quot;, &quot;&lt;/a&gt;&quot;, &quot;&lt;img src=&quot;&quot;&quot; _
+ , &quot;&lt;span class=&quot;&quot;&quot;, &quot;&lt;/span&gt;&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;a id=&quot;&quot;&quot;, &quot;&lt;img src=&quot;&quot;&quot;, &quot;&lt;span class=&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; 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 -----------------------------------------------------------------------------------------------------------------------
+Private Function _OutputToCalc(poData As Object _
+ , ByVal psOutputFile As String _
+ , ByVal psFilter As String _
+ , Optional ByVal plEncoding As Long _
+ ) As Boolean
+&apos; https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Database_Import
+&apos; https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options
+
+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
+ If IsMissing(plEncoding) Then plEncoding = acUTF8Encoding
+ &apos; Create a new OO-Calc-Document
+ Set oCalcDoc = StarDesktop.LoadComponentFromURL( _
+ &quot;private:factory/scalc&quot; _
+ , &quot;_default&quot; ,0, Array() _
+ )
+
+ &apos; Get the unique spreadsheet
+ Set oSheet = oCalcDoc.Sheets(0)
+
+ &apos; Describe import
+ With poData
+ If ._Type = &quot;TABLEDEF&quot; Then
+ iSource = com.sun.star.sheet.DataImportMode.TABLE
+ Else
+ iSource = com.sun.star.sheet.DataImportMode.QUERY
+ End If
+ vImportDesc = Array( _
+ _MakePropertyValue(&quot;DatabaseName&quot;, URL) _
+ , _MakePropertyValue(&quot;SourceType&quot;, iSource) _
+ , _MakePropertyValue(&quot;SourceObject&quot;, ._Name) _
+ )
+ oSheet.Name = ._Name
+ End With
+
+ &apos; Import
+ oSheet.getCellByPosition(0, 0).doImport(vImportDesc())
+
+ Select Case psFilter
+ Case acFormatODS, acFormatXLS, acFormatXLSX &apos; 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
+ oCalcDoc.storeAsUrl(psOutputFile, Array( _
+ _MakePropertyValue(&quot;FilterName&quot;, psFilter) _
+ , _MakePropertyValue(&quot;Overwrite&quot;, True) _
+ ))
+ Case Else
+ oCalcDoc.storeAsUrl(psOutputFile, Array( _
+ _MakePropertyValue(&quot;FilterName&quot;, psFilter) _
+ , _MakePropertyValue(&quot;FilterOptions&quot;, _FilterOptionsDefault(plEncoding)) _
+ , _MakePropertyValue(&quot;Overwrite&quot;, True) _
+ ))
+ End Select
+
+ 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 &apos; OutputToCalc V1.4.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+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
+&apos; 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 = &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()
+
+ bDataArray = IsNull(pvTable)
+
+&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), pvName)
+ Print #iFile, sLine
+ Case InStr(sLine, cstBody) &gt; 0
+ lBody = InStr(sLine, cstBody)
+ If lBody &gt; 1 Then Print #iFile, Left(sLine, lBody - 1)
+ If bDataArray Then
+ _OutputDataToHTML(pvTable, pvName, iFile, pvHeaders, pvData)
+ Else
+ _OutputDataToHTML(pvTable, pvName, iFile)
+ End If
+ 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;Connect&quot;, &quot;Name&quot;, &quot;ObjectType&quot; _
+ , &quot;OnCreate&quot;, &quot;OnFocus&quot;, &quot;OnLoad&quot;, &quot;OnLoadFinished&quot;, &quot;OnModifyChanged&quot; _
+ , &quot;OnNew&quot;, &quot;OnPrepareUnload&quot;, &quot;OnPrepareViewClosing&quot;, &quot;OnSave&quot;, &quot;OnSaveAs&quot; _
+ , &quot;OnSaveAsDone&quot;, &quot;OnSaveAsFailed&quot;, &quot;OnSaveDone&quot;, &quot;OnSaveFailed&quot;, &quot;OnSaveTo&quot; _
+ , &quot;OnSaveToDone&quot;, &quot;OnSaveToFailed&quot;, &quot;OnSubComponentClosed&quot;, &quot;OnSubComponentOpened&quot; _
+ , &quot;OnTitleChanged&quot;, &quot;OnUnfocus&quot;, &quot;OnUnload&quot;, &quot;OnViewClosed&quot;, &quot;OnViewCreated&quot; _
+ , &quot;Version&quot; _
+ )
+
+End Function &apos; _PropertiesList
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertyGet(ByVal psProperty As String) As Variant
+&apos; Return property value of the psProperty property name
+
+Dim i As Integer, vEvents As Variant, sEvent As String, vEvent As Variant
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+ Utils._SetCalledSub(&quot;Database.get&quot; &amp; psProperty)
+
+ _PropertyGet = EMPTY
+
+ Select Case UCase(psProperty)
+ Case UCase(&quot;Connect&quot;)
+ If IsNull(Document) Then _PropertyGet = &quot;&quot; Else _PropertyGet = Document.Datasource.URL
+ &apos; Location = ConvertFromUrl(URL)
+ Case UCase(&quot;Name&quot;)
+ _PropertyGet = Title
+ Case UCase(&quot;ObjectType&quot;)
+ _PropertyGet = _Type
+ Case UCase(&quot;OnCreate&quot;), UCase(&quot;OnFocus&quot;), UCase(&quot;OnLoad&quot;), UCase(&quot;OnLoadFinished&quot;), UCase(&quot;OnModifyChanged&quot;) _
+ , UCase(&quot;OnNew&quot;), UCase(&quot;OnPrepareUnload&quot;), UCase(&quot;OnPrepareViewClosing&quot;), UCase(&quot;OnSave&quot;), UCase(&quot;OnSaveAs&quot;) _
+ , UCase(&quot;OnSaveAsDone&quot;), UCase(&quot;OnSaveAsFailed&quot;), UCase(&quot;OnSaveDone&quot;), UCase(&quot;OnSaveFailed&quot;), UCase(&quot;OnSaveTo&quot;) _
+ , UCase(&quot;OnSaveToDone&quot;), UCase(&quot;OnSaveToFailed&quot;), UCase(&quot;OnSubComponentClosed&quot;), UCase(&quot;OnSubComponentOpened&quot;) _
+ , UCase(&quot;OnTitleChanged&quot;), UCase(&quot;OnUnfocus&quot;), UCase(&quot;OnUnload&quot;), UCase(&quot;OnViewClosed&quot;), UCase(&quot;OnViewCreated&quot;)
+ &apos; Find script event
+ sEvent = &quot;&quot;
+ If IsNull(Document) Then vEvents = Array() Else vEvents = Document.getEvents().ElementNames &apos; Returns an array
+ For i = 0 To UBound(vEvents)
+ If UCase(vEvents(i)) = UCase(psProperty) Then
+ sEvent = vEvents(i)
+ Exit For
+ End If
+ Next i
+ If sEvent = &quot;&quot; Then
+ _PropertyGet = &quot;&quot;
+ Else
+ vEvent = Document.getEvents().getByName(sEvent)
+ If IsEmpty(vEvent) Then
+ _PropertyGet = &quot;&quot;
+ ElseIf vEvent(0).Value &lt;&gt; &quot;Script&quot; Then
+ _PropertyGet = &quot;&quot;
+ Else
+ _PropertyGet = vEvent(1).Value
+ End If
+ End If
+ Case UCase(&quot;Version&quot;)
+ _PropertyGet = MetaData.getDatabaseProductName() &amp; &quot; &quot; &amp; MetaData.getDatabaseProductVersion
+ Case Else
+ Goto Trace_Error
+ End Select
+
+Exit_Function:
+ Utils._ResetCalledSub(&quot;Database.get&quot; &amp; psProperty)
+ Exit Function
+Trace_Error:
+ TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
+ _PropertyGet = EMPTY
+ Goto Exit_Function
+Error_Function:
+ TraceError(TRACEABORT, Err, &quot;Database._PropertyGet&quot;, Erl)
+ _PropertyGet = EMPTY
+ GoTo Exit_Function
+End Function &apos; _PropertyGet
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _ReplaceSquareBrackets(ByVal psSql As String) As String
+&apos; Returns psSql after substitution of [] by quote character
+&apos; [] square brackets in (single) quoted strings not affected
+
+Dim sQuote As String &apos;RDBMS specific quote character
+Dim vSubStrings() As Variant, i As Integer
+Const cstSingleQuote = &quot;&apos;&quot;
+
+ sQuote = MetaData.IdentifierQuoteString
+ If sQuote = &quot; &quot; Then &apos; IdentifierQuoteString returns a space &quot; &quot; if identifier quoting is not supported.
+ _ReplaceSquareBrackets = Trim(psSql)
+ Exit Function
+ End If
+ vSubStrings() = Split(psSql, cstSingleQuote)
+ For i = 0 To UBound(vSubStrings)
+ If (i Mod 2) = 0 Or (i = UBound(vSubStrings)) Then &apos; Only even substrings are parsed for square brackets. Last substring is parsed anyway
+ vSubStrings(i) = Join(Split(vSubStrings(i), &quot;[&quot;), sQuote)
+ vSubStrings(i) = Join(Split(vSubStrings(i), &quot;]&quot;), sQuote)
+ End If
+ Next i
+
+ _ReplaceSquareBrackets = Trim(Join(vSubStrings, cstSingleQuote))
+
+End Function &apos; ReplaceSquareBrackets V1.1.0
+
+</script:module> \ No newline at end of file