Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 


Quellcode-Bibliothek DoCmd.xba   Sprache: unbekannt

 
Spracherkennung für: .xba vermutete Sprache: Unknown {[0] [0] [0]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen]

<?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="DoCmd" 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 Explicit

Type _FindParams
 FindRecord    As Integer  ' Set to 1 at first invocation of FindRecord
 FindWhat    As Variant
 Match     As Integer
 MatchCase    As Boolean
 Search     As Integer
 SearchAsFormatted  As Boolean  ' Must be False
 FindFirst    As Boolean
 OnlyCurrentField  As Integer
 Form     As String  ' Shortcut
 GridControl    As String  ' Shortcut
 Target     As String  ' Shortcut
 LastRow     As Long   ' Last row explored - 0 = before first
 LastColumn    As Integer  ' Last column explored - 0 ... N-1 index in next arrays; 0 if OnlyCurrentField = acCurrent
 ColumnNames()   As String  ' Array of column names in grid with boundfield and of same type as FindWhat
 ResultSetIndex()  As Integer  ' Array of column numbers in ResultSet
End Type

Type _Window
 Frame     As Object  ' com.sun.star.comp.framework.Frame
 _Name     As String  ' Object Name
 WindowType    As Integer  ' One of the object types
 DocumentType   As String  ' Writer, Calc, ... - Only if WindowType = acDocument
End Type

REM VBA allows call to actions with missing arguments e.g. OpenForm("aaa",,"[field]=2")
REM in StarBasic IsMissing requires Variant parameters

REM -----------------------------------------------------------------------------------------------------------------------
Public Function ApplyFilter( _
     ByVal Optional pvFilter As Variant _
     , ByVal Optional pvSQL As Variant _
     , ByVal Optional pvControlName As Variant _
     ) As Boolean
' Set filter on open table, query, form or subform (if pvControlName present)

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "ApplyFilter"
 Utils._SetCalledSub(cstThisSub)
 ApplyFilter = False

 If IsMissing(pvFilter) And IsMissing(pvSQL) Then Call _TraceArguments()
 If IsMissing(pvFilter) Then pvFilter = ""
 If Not Utils._CheckArgument(pvFilter, 1, vbString) Then Goto Exit_Function
 If IsMissing(pvSQL) Then pvSQL = ""
 If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function
 If IsMissing(pvControlName) Then pvControlName = ""
 If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function

Dim sFilter As String, oWindow As Object, oDatabase As Object, oTarget As Object
 Set oDatabase = Application._CurrentDb()
 If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable

 If pvSQL <> "" _
   Then sFilter = oDatabase._ReplaceSquareBrackets(pvSQL) _
   Else sFilter = oDatabase._ReplaceSquareBrackets(pvFilter)

 Set oWindow = _SelectWindow()
 With oWindow
  Select Case .WindowType
   Case acForm
    Set oTarget = _DatabaseForm(._Name, pvControlName)
   Case acQuery, acTable
    If pvControlName <> "" Then Goto Exit_Function
    If IsNull(.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
      ' FormOperations returns <Null> in OpenOffice
    Set oTarget = .Frame.Controller.FormOperations.Cursor
   Case Else  ' Ignore action
    Goto Exit_Function
  End Select
 End With

 With oTarget
  .Filter = sFilter
  .ApplyFilter = True
  .reload()
 End With
 ApplyFilter = True

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_NotApplicable:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
End Function  ' ApplyFilter V1.2.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function mClose(Optional ByVal pvObjectType As Variant _
     , Optional ByVal pvObjectName As Variant _
     , Optional ByVal pvSave As Variant _
     ) As Boolean
 If _ErrorHandler() Then On Local Error Goto Error_Function

Const cstThisSub = "Close"
 Utils._SetCalledSub(cstThisSub)
 mClose = False
 If IsMissing(pvObjectType) Or IsMissing(pvObjectName) Then Call _TraceArguments()
 If IsMissing(pvSave) Then pvSave = acSavePrompt
 If Not (Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _
    Array(acTable, acQuery, acForm, acReport)) _
  And Utils._CheckArgument(pvObjectName, 2, vbString) _
  And Utils._CheckArgument(pvSave, 3, Utils._AddNumeric(), Array(acSavePrompt)) _
   ) Then Goto Exit_Function

Dim sObjects() As String, sObjectName As String, oController As Object, oObject As Object
Dim i As Integer, bFound As Boolean, lComponent As Long
Dim oDatabase As Object
 Set oDatabase = Application._CurrentDb()
 If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable

 ' Check existence of object and find its exact (case-sensitive) name
 Select Case pvObjectType
  Case acForm
   sObjects = Application._GetAllHierarchicalNames()
   lComponent = com.sun.star.sdb.application.DatabaseObject.FORM
  Case acTable
   sObjects = oDatabase.Connection.getTables.ElementNames()
   lComponent = com.sun.star.sdb.application.DatabaseObject.TABLE
  Case acQuery
   sObjects = oDatabase.Connection.getQueries.ElementNames()
   lComponent = com.sun.star.sdb.application.DatabaseObject.QUERY
  Case acReport
   sObjects = oDatabase.Document.getReportDocuments.ElementNames()
   lComponent = com.sun.star.sdb.application.DatabaseObject.REPORT
 End Select
 bFound = False
 For i = 0 To UBound(sObjects)
  If UCase(pvObjectName) = UCase(sObjects(i)) Then
   sObjectName = sObjects(i)
   bFound = True
   Exit For
  End If
 Next i
 If Not bFound Then Goto Trace_NotFound

 Select Case pvObjectType
  Case acForm
   Set oController = oDatabase.Document.getFormDocuments.getByHierarchicalName(sObjectName)
   mClose = oController.close()
  Case acTable, acQuery    ' Not optimal but it works !!
   Set oController = oDatabase.Document.CurrentController
   Set oObject = oController.loadComponent(lComponent, sObjectName, False)
   oObject.frame.close(False)
   mClose = True
  Case acReport
   Set oController = oDatabase.Document.getReportDocuments.getByName(sObjectName)
   mClose = oController.close()
 End Select


Exit_Function:
 Set oObject = Nothing
 Set oController = Nothing
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "Close", Erl)
 GoTo Exit_Function
Trace_Error:
 TraceError(TRACEFATAL, ERRCLOSEOBJECT, Utils._CalledSub(), 0, , Array(_GetLabel(Array("Table", "Query", "Form", "Report")(pvObjectType)), pvObjectName))
 Goto Exit_Function
Trace_NotFound:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(Array("Table", "Query", "Form", "Report")(pvObjectType)), pvObjectName))
 Goto Exit_Function
Error_NotApplicable:
 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
 Goto Exit_Function
End Function ' (m)Close V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function CopyObject(ByVal Optional pvSourceDatabase As Variant _
       , ByVal Optional pvNewName As Variant _
       , ByVal Optional pvSourceType As Variant _
       , ByVal Optional pvSourceName As Variant _
       ) As Boolean
' Copies tables and queries into identical (new) objects
 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "CopyObject"
 Utils._SetCalledSub(cstThisSub)
 CopyObject = False

 If IsMissing(pvSourceDatabase) Then pvSourceDatabase = ""
 If VarType(pvSourceDatabase) <> vbString Then
  If Not Utils._CheckArgument(pvSourceDatabase, 1, OBJDATABASE) Then Goto Exit_Function
 End If
 If IsMissing(pvNewName) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvNewName, 2, vbString) Then Goto Exit_Function
 If IsMissing(pvSourceType) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvSourceType, 1, Utils._AddNumeric(), Array(acQuery, acTable) _
   ) Then Goto Exit_Function
 If IsMissing(pvSourceName) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvSourceName, 2, vbString) Then Goto Exit_Function

Dim oSource As Object, oSourceDatabase As Object, oTarget As Object, oDatabase As Object, bSameDatabase As Boolean
Dim oSourceTable As Object, oSourceColumns As Object, oSourceCol As Object, oTargetCol As Object, iRDBMS As Integer
Dim oSourceKeys As Object, oSourceKey As Object, oTargetKey As Object
Dim i As Integer, j As Integer, sSql As String, vPrimaryKeys() As Variant
Dim vNameComponents() As Variant, iNames As Integer, sSurround As String
Dim vInputField As Variant, vFieldBinary() As Variant, vOutputField As Variant
Dim oInput as Object, oOutput As Object, iNbFields As Integer, vValue As Variant
Dim vBinary As Variant, lInputSize As Long, lOutputSize As Long
Dim lInputRecs As Long, lInputMax As Long, vField As Variant, bProgressMeter As Boolean, sFile As String

Const cstMaxBinlength = 2 * 65535
Const cstChunkSize = 2 * 65535
Const cstProgressMeterLimit = 100

 Set oDatabase = Application._CurrentDb()
 bSameDatabase = False
 If VarType(pvSourceDatabase) = vbString Then
  If pvSourceDatabase = "" Then
   Set oSourceDatabase = oDatabase
   bSameDatabase = True
  Else
   Set oSourceDatabase = Application.OpenDatabase(ConvertToUrl(pvSourceDatabase), "", "", True)
   If IsNull(oSourceDatabase) Then Goto Exit_Function
  End If
 Else
  Set oSourceDatabase = pvSourceDatabase
 End If

 With oDatabase
  iRDBMS = ._RDBMS
  If ._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
  Select Case pvSourceType

   Case acQuery
    Set oSource = oSourceDatabase.QueryDefs(pvSourceName, True)
    If IsNull(oSource) Then Goto Error_NotFound
    Set oTarget = .QueryDefs(pvNewName, True)
    If Not IsNull(oTarget) Then .Connection.getQueries.dropByName(oTarget.Name)  ' a query with same name exists already ... drop it
    If oSource.Query.EscapeProcessing Then
     Set oTarget = .CreateQueryDef(pvNewName, oSource.SQL)
    Else
     Set oTarget = .CreateQueryDef(pvNewName, oSource.SQL, dbSQLPassThrough)
    End If
    ' Save .odb document
    .Document.store()

   Case acTable
    Set oSource = oSourceDatabase.TableDefs(pvSourceName, True)
    If IsNull(oSource) Then Goto Error_NotFound
    Set oTarget = .TableDefs(pvNewName, True)
    ' A table with same name exists already ... drop it
    If Not IsNull(oTarget) Then .Connection.getTables.dropByName(oTarget.Name)
    ' Copy source table columns
    Set oSourceTable = oSource.Table
    Set oTarget = .Connection.getTables.createDataDescriptor
    oTarget.Description = oSourceTable.Description
    vNameComponents = Split(pvNewName, ".")
    iNames = UBound(vNameComponents)
    If iNames >= 2 Then oTarget.CatalogName = vNameComponents(iNames - 2) Else oTarget.CatalogName = ""
    If iNames >= 1 Then oTarget.SchemaName = vNameComponents(iNames - 1) Else oTarget.SchemaName = ""
    oTarget.Name = vNameComponents(iNames)
    oTarget.Type = oSourceTable.Type
    Set oSourceColumns = oSourceTable.Columns
    Set oTargetCol = oTarget.Columns.createDataDescriptor
    For i = 0 To oSourceColumns.getCount() - 1
     ' Append each individual column to the table descriptor
     Set oSourceCol = oSourceColumns.getByIndex(i)
     _ConvertDataDescriptor oSourceCol, oSourceDatabase._RDBMS, oTargetCol, oDatabase
     oTarget.Columns.appendByDescriptor(oTargetCol)
    Next i

    ' Copy keys
    Set oSourceKeys = oSourceTable.Keys
    Set oTargetKey = oTarget.Keys.createDataDescriptor()
    For i = 0 To oSourceKeys.getCount() - 1
     ' Append each key to table descriptor
     Set oSourceKey = oSourceKeys.getByIndex(i)
     oTargetKey.DeleteRule = oSourceKey.DeleteRule
     oTargetKey.Name = oSourceKey.Name
     oTargetKey.ReferencedTable = oSourceKey.ReferencedTable
     oTargetKey.Type = oSourceKey.Type
     oTargetKey.UpdateRule = oSourceKey.UpdateRule
     Set oTargetCol = oTargetKey.Columns.createDataDescriptor()
      For j = 0 To oSourceKey.Columns.getCount() - 1
      Set oSourceCol = oSourceKey.Columns.getByIndex(j)
      _ConvertDataDescriptor oSourceCol, oSourceDatabase._RDBMS, oTargetCol, oDatabase, True
      oTargetKey.Columns.appendByDescriptor(oTargetCol)
     Next j
     oTarget.Keys.appendByDescriptor(oTargetKey)
    Next i
    ' Duplicate table whole design
    .Connection.getTables.appendByDescriptor(oTarget)

    ' Copy data
    Select Case bSameDatabase
     Case True
     ' Build SQL statement to copy data
      sSurround = Utils._Surround(oSource.Name)
      sSql = "INSERT INTO " & Utils._Surround(pvNewName) & " SELECT " & sSurround & ".* FROM " & sSurround
      DoCmd.RunSQL(sSql)
     Case False
     ' Copy data row by row and field by field
     ' As it is slow ... display a progress meter
      Set oInput = oSourceDatabase.OpenRecordset(oSource.Name, , , dbReadOnly)
      Set oOutput = .Openrecordset(pvNewName)

      With oInput
       If Not ( ._BOF And ._EOF ) Then
        .MoveLast
        lInputMax = .RecordCount
        lInputRecs = 0
        .MoveFirst
        bProgressMeter = ( lInputMax > cstProgressMeterLimit )

        iNbFields = .Fields().Count - 1
        vFieldBinary = Array()
        ReDim vFieldBinary(0 To iNbFields)
        For i = 0 To iNbFields
         vFieldBinary(i) = Utils._IsBinaryType(.Fields(i).Column.Type)
        Next i
       Else
        bProgressMeter = False
       End If
       If bProgressMeter Then Application.SysCmd acSysCmdInitMeter, pvNewName & " 0 %", lInputMax
       Do While Not .EOF()
        oOutput.RowSet.moveToInsertRow()
        oOutput._EditMode = dbEditAdd
        For i = 0 To iNbFields
         Set vInputField = .Fields(i)
         Set vOutputField = oOutput.Fields(i)
         If vFieldBinary(i) Then
          lInputSize = vInputField.FieldSize
          If lInputSize <= cstMaxBinlength Then
           vField =  Utils._getResultSetColumnValue(.RowSet, i + 1, True)
           Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField)
          ElseIf oDatabase._BinaryStream Then
           ' Typically for SQLite where binary fields are limited
           If lInputSize > vOutputField._Precision Then
            TraceError(TRACEWARNING, ERRPRECISION, Utils._CalledSub(), 0, 1, Array(vOutputField._Name, lInputRecs + 1))
            Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, Null)
           Else
            sFile = Utils._GetRandomFileName("BINARY")
            vInputField._WriteAll(sFile, "WriteAllBytes")
            vOutputField._ReadAll(sFile, "ReadAllBytes")
            Kill ConvertToUrl(sFile)
           End If
          End If
         Else
          vField =  Utils._getResultSetColumnValue(.RowSet, i + 1)
          If VarType(vField) = vbString Then
           If Len(vField) > vOutputField._Precision Then
            TraceError(TRACEWARNING, ERRPRECISION, Utils._CalledSub(), 0, 1, Array(vOutputField._Name, lInputRecs + 1))
           End If
          End If
          ' Update is done anyway, if too long, with truncation
          Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField)
         End If
        Next i

        If oOutput.RowSet.IsNew And oOutput.RowSet.IsModified Then oOutput.RowSet.insertRow()
        oOutput._EditMode = dbEditNone
        lInputRecs = lInputRecs + 1
        If bProgressMeter Then
         If lInputRecs Mod (lInputMax / 100) = 0 Then
          Application.SysCmd acSysCmdUpdateMeter, pvNewName & " " & CStr(CLng(lInputRecs * 100 / lInputMax)) & "%", lInputRecs
         End If
        End If
        .MoveNext
       Loop
      End With

      oOutput.mClose()
      Set oOutput = Nothing
      oInput.mClose()
      Set oInput = Nothing
      if bProgressMeter Then Application.SysCmd acSysCmdClearStatus
    End Select

   Case Else
  End Select
 End With

 CopyObject = True

Exit_Function:
 ' Avoid closing the current database or the database object given as source argument
 If VarType(pvSourceDatabase) = vbString And Not bSameDatabase Then
  If Not IsNull(oSourceDatabase) Then oSourceDatabase.mClose()
 End If
 Set oSourceDatabase = Nothing
 If Not IsNull(oOutput) Then oOutput.mClose()
 Set oOutput = Nothing
 If Not IsNull(oInput) Then oInput.mClose()
 Set oInput = Nothing
 Set oSourceCol = Nothing
 Set oSourceKey = Nothing
 Set oSourceKeys = Nothing
 Set oSource = Nothing
 Set oSourceTable = Nothing
 Set oSourceColumns = Nothing
 Set oTargetCol = Nothing
 Set oTargetKey = Nothing
 Set oTarget = Nothing
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_NotFound:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(Iif(pvSourceType = acQuery, _GetLabel("QUERY"), _GetLabel("TABLE")), pvSourceName))
 Goto Exit_Function
Error_NotApplicable:
 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
End Function ' CopyObject V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function FindNext() As Boolean
' Must be called after a FindRecord
' Execute instructions set in FindRecord object

 If _ErrorHandler() Then On Local Error Goto Error_Function
 FindNext = False
 Utils._SetCalledSub("FindNext")

Dim ofForm As Object, ocGrid As Object
Dim i As Integer, lInitialRow As Long, lFindRow As Long
Dim bFound As Boolean, b2ndRound As Boolean, bStop As Boolean
Dim vFindValue As Variant, oFindrecord As Object

 Set oFindRecord = _A2B_.FindRecord
 If IsNull(oFindRecord) Then GoTo Error_FindRecord
 With oFindRecord

  If .FindRecord = 0 Then Goto Error_FindRecord
  .FindRecord = 0
  Set ofForm = getObject(.Form)
  If ofForm._Type = OBJCONTROL Then Set ofForm = ofForm.Form  ' Bug Tombola
  Set ocGrid = getObject(.GridControl)

  ' Move cursor to the initial row. Operation based on last FindRecord, not on user interactions done inbetween
  If ofForm.DatabaseForm.RowCount <= 0 then Goto Exit_Function     ' Dataset is empty

  lInitialRow = .LastRow   ' Used if Search = acSearchAll

  bFound = False
  lFindRow = .LastRow
  b2ndRound = False
  Do
   ' Last column ? Go to next row
   If .LastColumn >= UBound(.ColumnNames) Then
    bStop = False
    If ofForm.DatabaseForm.isAfterLast() And .Search = acUp Then
     ofForm.DatabaseForm.last()
    ElseIf ofForm.DatabaseForm.isLast() And .Search = acSearchAll Then
     ofForm.DatabaseForm.first()
     b2ndRound = True
    ElseIf ofForm.DatabaseForm.isBeforeFirst() And (.Search = acDown Or .Search = acSearchAll) Then
     ofForm.DatabaseForm.first()
    ElseIf ofForm.DatabaseForm.isFirst() And .search = acUp Then
     ofForm.DatabaseForm.beforeFirst()
     bStop = True
    ElseIf ofForm.DatabaseForm.isLast() And .search = acDown Then
     ofForm.DatabaseForm.afterLast()
     bStop = True
    ElseIf .Search = acUp Then
     ofForm.DatabaseForm.previous()
    Else
     ofForm.DatabaseForm.next()
    End If
    lFindRow = ofForm.DatabaseForm.getRow()
    If bStop Or (.Search = acSearchAll And lFindRow >= lInitialRow And b2ndRound) Then
     ofForm.DatabaseForm.absolute(lInitialRow)
     Exit Do
    End If
    .LastColumn = 0
   Else
    .LastColumn = .LastColumn + 1
   End If

   ' Examine column contents
   If .LastColumn <= UBound(.ColumnNames) Then
    For i = .LastColumn To UBound(.ColumnNames)
     vFindValue = Utils._getResultSetColumnValue(ofForm.DatabaseForm.createResultSet(), .ResultSetIndex(i))
     Select Case VarType(.FindWhat)
      Case vbDate, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
       bFound = ( .FindWhat = vFindValue )
      Case vbString
       If VarType(vFindValue) = vbString Then
        Select Case .Match
         Case acStart
          If .MatchCase Then
           bFound = ( Left(.FindWhat, Len(.FindWhat)) = vFindValue )
          Else
           bFound = ( UCase(Left(.FindWhat, Len(.FindWhat))) = UCase(vFindValue) )
          End If
         Case acAnyWhere
          If .MatchCase Then
           bFound = ( InStr(1, vFindValue, .FindWhat, 0) > 0 )
          Else
           bFound = ( InStr(vFindValue, .FindWhat) > 0 )
          End If
         Case acEntire
          If .MatchCase Then
           bFound = ( .FindWhat = vFindValue )
          Else
           bFound = ( UCase(.FindWhat) = UCase(vFindValue) )
          End If
        End Select
       Else
        bFound = False
       End If
     End Select
     If bFound Then
      .LastColumn = i
      Exit For
     End If
    Next i
   End If
  Loop While Not bFound

  .LastRow = lFindRow
  If bFound Then
   ocGrid.Controls(.ColumnNames(.LastColumn)).setFocus()
   .FindRecord = 1
   FindNext = True
  End If

 End With

Exit_Function:
 Utils._ResetCalledSub("FindNext")
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "FindNext", Erl)
 GoTo Exit_Function
Error_FindRecord:
 TraceError(TRACEERRORS, ERRFINDRECORD, Utils._CalledSub(), 0)
 Goto Exit_Function
End Function ' FindNext V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function FindRecord(Optional ByVal pvFindWhat As Variant _
   , Optional ByVal pvMatch As Variant _
   , Optional ByVal pvMatchCase As Variant _
   , Optional ByVal pvSearch As Variant _
   , Optional ByVal pvSearchAsFormatted As Variant _
   , Optional ByVal pvTargetedField As Variant _
   , Optional ByVal pvFindFirst As Variant _
   ) As Boolean

'Find a value (string or other) in the underlying data of a gridcontrol
'Search in all columns or only in one single control
' see pvTargetedField = acAll or acCurrent
' pvTargetedField may also be a shortcut to a GridControl or one of its subcontrols
'Initialize _Findrecord structure in Database root and call FindNext() to set cursor on found value

 If _ErrorHandler() Then On Local Error Goto Error_Function
 FindRecord = False

 Utils._SetCalledSub("FindRecord")
 If IsMissing(pvFindWhat) Or pvFindWhat = "" Then Call _TraceArguments()
 If IsMissing(pvMatch) Then pvMatch = acEntire
 If IsMissing(pvMatchCase) Then pvMatchCase = False
 If IsMissing(pvSearch) Then pvSearch = acSearchAll
 If IsMissing(pvSearchAsFormatted) Then pvSearchAsFormatted = False  ' Anyway only False supported
 If IsMissing(pvTargetedField) Then pvTargetedField = acCurrent
 If IsMissing(pvFindFirst) Then pvFindFirst = True
 If Not (Utils._CheckArgument(pvFindWhat, 1, Utils._AddNumeric(Array(vbString, vbDate))) _
  And Utils._CheckArgument(pvMatch, 2, Utils._AddNumeric(), Array(acAnywhere, acEntire, acStart)) _
  And Utils._CheckArgument(pvMatchCase, 3, vbBoolean) _
  And Utils._CheckArgument(pvSearch, 4, Utils._AddNumeric(), Array(acDown, acSearchAll, acUp)) _
  And Utils._CheckArgument(pvSearchAsFormatted, 5, vbBoolean, Array(False)) _
  And Utils._CheckArgument(pvTargetedField, 6, Utils._AddNumeric(vbString)) _
  And Utils._CheckArgument(pvFindFirst, 7, vbBoolean) _
  ) Then Exit Function
 If VarType(pvTargetedField) <> vbString Then
  If Not Utils._CheckArgument(pvTargetedField, 6, Utils._AddNumeric(), Array(acAll, acCurrent)) Then Exit Function
 End If

Dim ocTarget As Object, i As Integer, j As Integer, vNames() As Variant, iCount As Integer, vIndexes() As Variant
Dim vColumn As Variant, vDataField As Variant, ofParentForm As Variant, oColumns As Object, vParentGrid As Object
Dim bFound As Boolean, ocGridControl As Object, iFocus As Integer
Dim oFindRecord As _FindParams
 With oFindRecord
  .FindRecord = 0
  .FindWhat = pvFindWhat
  .Match = pvMatch
  .MatchCase = pvMatchCase
  .Search = pvSearch
  .SearchAsFormatted = pvSearchAsFormatted
  .FindFirst = pvFindFirst

  ' Determine target
  '  Either:  pvTargetedField = Grid     => search all fields
  '     pvTargetedField = Control in Grid  => search only in that column
  '     pvTargetedField = acAll or acCurrent => determine focus
  Select Case True

   Case VarType(pvTargetedField) = vbString
    Set ocTarget = getObject(pvTargetedField)

    If ocTarget.SubType = CTLGRIDCONTROL Then
     .OnlyCurrentField = acAll
     .GridControl = ocTarget._Shortcut
     .Target = .GridControl
     ofParentForm = getObject(_getUpperShortcut(ocTarget._Shortcut, ocTarget._Name))
     If IsNull(ofParentForm.DatabaseForm) Then Goto Error_DatabaseForm
     Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns
     iCount = -1
     For i = 0 To ocTarget.ControlModel.Count - 1
      Set vColumn = ocTarget.ControlModel.getByIndex(i)
      Set vDataField = vColumn.BoundField ' examine field type
      If Not IsNull(vDataField) Then
       If _CheckColumnType(pvFindWhat, vDataField) Then
        iCount = iCount + 1
        ReDim Preserve vNames(0 To iCount)
        vNames(iCount) = vColumn.Name
        ReDim Preserve vIndexes(0 To iCount)
        For j = 0 To oColumns.Count - 1
         If vDataField.Name = oColumns.ElementNames(j) Then
          vIndexes(iCount) = j + 1
          Exit For
         End If
        Next j
       End If
      End If
     Next i

    ElseIf ocTarget._Type = OBJCONTROL Then ' Control within a grid tbc
     If IsNull(ocTarget.ControlModel.BoundField) Then Goto Error_Target  ' Control MUST be bound to a database record or query
     ' BoundField is in ControlModel, thanks PASTIM !
     .OnlyCurrentField = acCurrent
     vParentGrid = getObject(_getUpperShortcut(ocTarget._Shortcut, ocTarget._Name))
     If vParentGrid.SubType <> CTLGRIDCONTROL Then Goto Error_Target
     .GridControl = vParentGrid._Shortcut
     ofParentForm = getObject(_getUpperShortcut(vParentGrid._Shortcut, vParentGrid._Name))
     If ofParentForm._Type = OBJCONTROL Then Set ofParentForm = ofParentForm.Form  ' Bug Tombola
     If IsNull(ofParentForm.DatabaseForm) Then Goto Error_DatabaseForm
     .Target = ocTarget._Shortcut
     Set vDataField = ocTarget.ControlModel.BoundField
     If Not _CheckColumnType(pvFindWhat, vDataField) Then Goto Error_Target
     ReDim vNames(0), vIndexes(0)
     vNames(0) = ocTarget._Name
     Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns
     For j = 0 To oColumns.Count - 1
      If vDataField.Name = oColumns.ElementNames(j) Then
       vIndexes(0) = j + 1
       Exit For
      End If
     Next j
    End If

   Case Else       ' Determine focus
    iCount = Application.Forms()._Count
    If iCount = 0 Then Goto Error_ActiveForm
    bFound = False
    For i = 0 To iCount - 1   ' Determine form having the focus
     Set ofParentForm = Application.Forms(i)
     If ofParentForm.Component.CurrentController.Frame.IsActive() Then
      bFound = True
      Exit For
     End If
    Next i
    If Not bFound Then Goto Error_ActiveForm
    If IsNull(ofParentForm.DatabaseForm) Then Goto Error_DatabaseForm
    iCount = ofParentForm.Controls().Count
    bFound = False
    For i = 0 To iCount - 1
     Set ocGridControl = ofParentForm.Controls(i)
     If ocGridControl.SubType = CTLGRIDCONTROL Then
      bFound = True
      Exit For
     End If
    Next i
    If Not bFound Then Goto Error_NoGrid
    .GridControl= ocGridControl._Shortcut
    iFocus = -1
    iFocus = ocGridControl.ControlView.getCurrentColumnPosition() ' Deprecated but no alternative found !!

    If pvTargetedField = acAll Or iFocus < 0  Or iFocus >= ocGridControl.ControlModel.Count Then ' Has a control within the grid the focus ? NO
     .OnlyCurrentField = acAll
     Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns
     iCount = -1
     For i = 0 To ocGridControl.ControlModel.Count - 1
      Set vColumn = ocGridControl.ControlModel.getByIndex(i)
      Set vDataField = vColumn.BoundField ' examine field type
      If Not IsNull(vDataField) Then
       If _CheckColumnType(pvFindWhat, vDataField) Then
        iCount = iCount + 1
        ReDim Preserve vNames(0 To iCount)
        vNames(iCount) = vColumn.Name
        ReDim Preserve vIndexes(0 To iCount)
        For j = 0 To oColumns.Count - 1
         If vDataField.Name = oColumns.ElementNames(j) Then
          vIndexes(iCount) = j + 1
          Exit For
         End If
        Next j
       End If
      End If
     Next i

    Else                ' Has a control within the grid the focus ? YES
     .OnlyCurrentField = acCurrent
     Set vColumn = ocGridControl.ControlModel.getByIndex(iFocus)
     Set ocTarget = ocGridControl.Controls(vColumn.Name)
     .Target = ocTarget._Shortcut
     Set vDataField = ocTarget.ControlModel.BoundField
     If IsNull(vDataField) Then Goto Error_Target  ' Control MUST be bound to a database record or query
     If Not _CheckColumnType(pvFindWhat, vDataField) Then Goto Error_Target
     ReDim vNames(0), vIndexes(0)
     vNames(0) = ocTarget._Name
     Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns
     For j = 0 To oColumns.Count - 1
      If vDataField.Name = oColumns.ElementNames(j) Then
       vIndexes(0) = j + 1
       Exit For
      End If
     Next j
    End If

  End Select

  .Form = ofParentForm._Shortcut
  .LastColumn = UBound(vNames)
  .ColumnNames = vNames
  .ResultSetIndex = vIndexes
  If pvFindFirst Then
   Select Case pvSearch
    Case acDown, acSearchAll
     ofParentForm.DatabaseForm.beforeFirst()
     .LastRow = 0
    Case acUp
     ofParentForm.DatabaseForm.afterLast()
     .LastRow = ofParentForm.DatabaseForm.RowCount + 1
   End Select
  Else
   Select Case True
    Case ofParentForm.DatabaseForm.isBeforeFirst And (pvSearch = acSearchAll Or pvSearch = acDown)
     .LastRow = 0
    Case ofParentForm.DatabaseForm.isAfterLast And pvSearch = acUp
     ofParentForm.DatabaseForm.last()  ' RowCount produces a wrong value as long as last record has not been reached
     .LastRow = ofParentForm.DatabaseForm.RowCount + 1
    Case Else
     .LastRow = ofParentForm.DatabaseForm.getRow()
   End Select
  End If

  .FindRecord = 1

 End With
 Set _A2B_.FindRecord = oFindRecord
 FindRecord = DoCmd.Findnext()

Exit_Function:
 Utils._ResetCalledSub("FindRecord")
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "FindRecord", Erl)
 GoTo Exit_Function
Error_ActiveForm:
 TraceError(TRACEERRORS, ERRNOACTIVEFORM, Utils._CalledSub(), 0)
 Goto Exit_Function
Error_DatabaseForm:
 TraceError(TRACEFATAL, ERRDATABASEFORM, Utils._CalledSub(), 0, 1, vParentForm._Name)
 Goto Exit_Function
Error_Target:
 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(6, pvTargetedField))
 Goto Exit_Function
Error_NoGrid:
 TraceError(TRACEFATAL, ERRNOGRIDINFORM, Utils._CalledSub(), 0, 1, vParentForm._Name)
 Goto Exit_Function
End Function  ' FindRecord  V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function GetHiddenAttribute(ByVal Optional pvObjectType As Variant _
        , ByVal Optional pvObjectName As Variant _
        ) As Boolean

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "GetHiddenAttribute"
 Utils._SetCalledSub(cstThisSub)

 If IsMissing(pvObjectType) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _
   Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow, acDocument) _
   ) Then Goto Exit_Function
 If IsMissing(pvObjectName) Then
  Select Case pvObjectType
   Case acForm, acQuery, acTable, acReport, acDocument  : Call _TraceArguments()
   Case Else
  End Select
  pvObjectName = ""
 Else
  If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
 End If

Dim oWindow As Object
 Set oWindow = _SelectWindow(pvObjectType, pvObjectName)
 If IsNull(oWindow.Frame) Then Goto Error_NotFound
 GetHiddenAttribute = Not oWindow.Frame.ContainerWindow.isVisible()

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_NotFound:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName))
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
End Function  ' GetHiddenAttribute V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function GoToControl(Optional ByVal pvControlName As Variant) As Boolean
' Set the focus on the named control on the active form.
' Return False if the control does not exist or is disabled,

 If _ErrorHandler() Then On Local Error Goto Error_Function
 Utils._SetCalledSub("GoToControl")
 If IsMissing(pvControlName) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function

 GoToControl = False
Dim oWindow As Object, ofForm As Object, ocControl As Object
Dim i As Integer, iCount As Integer
 Set oWindow = _SelectWindow()
 If oWindow.WindowType = acForm Then
  Set ofForm = Application.Forms(oWindow._Name)
  iCount = ofForm.Controls().Count
  For i = 0 To iCount - 1
   ocControl = ofForm.Controls(i)
   If UCase(ocControl._Name) = UCase(pvControlName) Then
    If Methods.hasProperty(ocControl, "Enabled") Then
     If ocControl.Enabled Then
      ocControl.setFocus()
      GoToControl = True
      Exit For
     End If
    End If
   End If
  Next i
 End If

Exit_Function:
 Utils._ResetCalledSub("GoToControl")
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "GoToControl", Erl)
 GoTo Exit_Function
End Function  ' GoToControl  V0.9.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function GoToRecord(Optional ByVal pvObjectType As Variant _
       , Optional ByVal pvObjectName As Variant _
       , Optional ByVal pvRecord As Variant _
       , Optional ByVal pvOffset As Variant _
   ) As Boolean

'Move to record indicated by pvRecord/pvOffset in the window designated by pvObjectType and pvObjectName

 If _ErrorHandler() Then On Local Error Goto Error_Function
 GoToRecord = False

Const cstThisSub = "GoTorecord"
 Utils._SetCalledSub(cstThisSub)
 If IsMissing(pvObjectName) Then pvObjectName = ""
 If IsMissing(pvObjectType) Then pvObjectType = acActiveDataObject
 If IsMissing(pvRecord) Then pvRecord = acNext
 If IsMissing(pvOffset) Then pvOffset = 1
 If Not (Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric() _
    , Array(acActiveDataObject, acDataForm, acDataQuery, acDataTable)) _
  And Utils._CheckArgument(pvObjectName, 2, vbString) _
  And Utils._CheckArgument(pvRecord, 3, Utils._AddNumeric() _
    , Array(acFirst, acGoTo, acLast, acNewRec, acNext, acPrevious)) _
  And Utils._CheckArgument(pvOffset, 4, Utils._AddNumeric()) _
  ) Then Goto Exit_Function
 If pvObjectType = acActiveDataObject And pvObjectName <> "" Then Goto Error_Target
 If pvOffset < 0 And pvRecord <> acGoTo Then Goto Error_Offset

Dim ofForm As Object, oGeneric As Object, oResultSet As Object, oWindow As Object
Dim i As Integer, iCount As Integer, bFound As Boolean, lOffset As Long
Dim sObjectName, iLengthName As Integer
 Select Case pvObjectType
  Case acActiveDataObject
   Set oWindow = _SelectWindow()
   With oWindow
    Select Case .WindowType
     Case acForm
      Set oResultSet = _DatabaseForm(._Name, "")
     Case acQuery, acTable
      If IsNull(.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
        ' FormOperations returns <Null> in OpenOffice
      Set oResultSet = .Frame.Controller.FormOperations.Cursor
     Case Else  ' Ignore action
      Goto Exit_Function
    End Select
   End With
  Case acDataForm
   ' pvObjectName can be "myForm", "Forms!myForm", "Forms!myForm!mySubform" or "Forms!myForm!mySubform.Form"
   sObjectName = UCase(pvObjectName)
   iLengthName = Len(sObjectName)
   Select Case True
    Case iLengthName > 6 And Left(sObjectName, 6) = "FORMS!" And Right(sObjectName, 5) = ".FORM"
     Set ofForm = getObject(pvObjectName)
     If ofForm._Type <> OBJSUBFORM Then Goto Error_Target
    Case iLengthName > 6 And Left(sObjectName, 6) = "FORMS!"
     Set oGeneric = getObject(pvObjectName)
     If oGeneric._Type = OBJFORM Or oGeneric._Type = OBJSUBFORM Then
      Set ofForm = oGeneric
     ElseIf oGeneric.SubType = CTLSUBFORM Then
      Set ofForm = oGeneric.Form
     Else Goto Error_Target
     End If
    Case sObjectName = ""
     Call _TraceArguments()
    Case Else
     Set ofForm = Application.Forms(pvObjectName)
   End Select
   Set oResultSet = ofForm.DatabaseForm
  Case acDataQuery
   Set oWindow = _SelectWindow(acQuery, pvObjectName)
   If IsNull(oWindow.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
      ' FormOperations returns <Null> in OpenOffice
   Set oResultSet = oWindow.Frame.Controller.FormOperations.Cursor
  Case acDataTable
   Set oWindow = _SelectWindow(acTable, pvObjectName)
   If IsNull(oWindow.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
   Set oResultSet = oWindow.Frame.Controller.FormOperations.Cursor
  Case Else
 End Select

 ' Check if current row updated => Save it
 If oResultSet.IsNew Then
  oResultSet.insertRow()
 ElseIf oResultSet.IsModified Then
  oResultSet.updateRow()
 End If

 lOffset = pvOffset
 Select Case pvRecord
  Case acFirst    :   GoToRecord = oResultSet.first()
  Case acGoTo     :   GoToRecord = oResultSet.absolute(lOffset)
  Case acLast     :   GoToRecord = oResultSet.last()
  Case acNewRec
   oResultSet.last()    ' To simulate the behaviour in the UI
   oResultSet.moveToInsertRow()
   GoToRecord = True
  Case acNext
   If lOffset = 1 Then
    GoToRecord = oResultSet.next()
   Else
    GoToRecord = oResultSet.relative(lOffset)
   End If
  Case acPrevious
   If lOffset = 1 Then
    GoToRecord = oResultSet.previous()
   Else
    GoToRecord = oResultSet.relative(- lOffset)
   End If
 End Select

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
Error_Target:
 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(2, pvObjectName))
 Goto Exit_Function
Error_Offset:
 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(4, pvOffset))
 Goto Exit_Function
Error_NotApplicable:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
 Goto Exit_Function
End Function  ' GoToRecord

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Maximize() As Boolean
' Maximize the window having the focus
 Utils._SetCalledSub("Maximize")

Dim oWindow As Object
 Maximize = False
 Set oWindow = _SelectWindow()
 If Not IsNull(oWindow.Frame) Then
  If Utils._hasUNOProperty(oWindow.Frame.ContainerWindow, "IsMaximized") Then oWindow.Frame.ContainerWindow.IsMaximized = True ' Ignored when <= OO3.2
  Maximize = True
 End If

 Utils._ResetCalledSub("Maximize")
 Exit Function
End Function ' Maximize V0.8.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Minimize() As Boolean
' Maximize the form having the focus
 Utils._SetCalledSub("Minimize")

Dim oWindow As Object
 Minimize = False
 Set oWindow = _SelectWindow()
 If Not IsNull(oWindow.Frame) Then
  If Utils._hasUNOProperty(oWindow.Frame.ContainerWindow, "IsMinimized") Then oWindow.Frame.ContainerWindow.IsMinimized = True
  Minimize = True
 End If

 Utils._ResetCalledSub("Minimize")
 Exit Function
End Function ' Minimize V0.8.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function MoveSize(ByVal Optional pvLeft As Variant _
      , ByVal Optional pvTop As Variant _
      , ByVal Optional pvWidth As Variant _
      , ByVal Optional pvHeight As Variant _
      ) As Variant
' Execute MoveSize action
 If _ErrorHandler() Then On Local Error Goto Error_Function
 Utils._SetCalledSub("MoveSize")
 MoveSize = False
 If IsMissing(pvLeft) Then pvLeft = -1
 If IsMissing(pvTop) Then pvTop = -1
 If IsMissing(pvWidth) Then pvWidth = -1
 If IsMissing(pvHeight) Then pvHeight = -1
 If Not Utils._CheckArgument(pvLeft, 1, Utils._AddNumeric()) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvTop, 2, Utils._AddNumeric()) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvWidth, 3, Utils._AddNumeric()) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvHeight, 4, Utils._AddNumeric()) Then Goto Exit_Function

Dim iArg As Integer, iWrong As Integer  ' Check arguments values
 iArg = 0
 If pvHeight < -1 Then
  iArg = 4  :  iWrong = pvHeight
 ElseIf pvWidth < -1 Then
  iArg = 3  :  iWrong = pvWidth
 ElseIf pvTop < -1 Then
  iArg = 2  :  iWrong = pvTop
 ElseIf pvLeft < -1 Then
  iArg = 1  :  iWrong = pvLeft
 End If
 If iArg > 0 Then
  TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(iArg, iWrong))
  Goto Exit_Function
 End If

Dim iPosSize As Integer
 iPosSize = 0
 If pvLeft >= 0  Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X
 If pvTop >= 0  Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y
 If pvWidth > 0  Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH
 If pvHeight > 0  Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT

Dim oWindow As Object
 Set oWindow = _SelectWindow()
 With oWindow
  If Not IsNull(.Frame) Then
   If Utils._hasUNOProperty(.Frame.ContainerWindow, "IsMaximized") Then ' Ignored when <= OO3.2
    .Frame.ContainerWindow.IsMaximized = False
    .Frame.ContainerWindow.IsMinimized = False
   End If
   .Frame.ContainerWindow.setPosSize(pvLeft, pvTop, pvWidth, pvHeight, iPosSize)
   MoveSize = True
  End If
 End With

Exit_Function:
 Utils._ResetCalledSub("MoveSize")
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "MoveSize", Erl)
 GoTo Exit_Function
End Function  ' MoveSize V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function OpenForm(Optional ByVal pvFormName As Variant _
   , Optional ByVal pvView As Variant _
   , Optional ByVal pvFilterName As Variant _
   , Optional ByVal pvWhereCondition As Variant _
   , Optional ByVal pvDataMode As Variant _
   , Optional ByVal pvWindowMode As Variant _
   , Optional ByVal pvOpenArgs As Variant _
   ) As Variant

 If _ErrorHandler() Then On Local Error Goto Error_Function

 Utils._SetCalledSub("OpenForm")
 If IsMissing(pvFormName) Then Call _TraceArguments()
 If IsMissing(pvView) Then pvView = acNormal
 If IsMissing(pvFilterName) Then pvFilterName = ""
 If IsMissing(pvWhereCondition) Then pvWhereCondition = ""
 If IsMissing(pvDataMode) Then pvDataMode = acFormPropertySettings
 If IsMissing(pvWindowMode) Then pvWindowMode = acWindowNormal
 If IsMissing(pvOpenArgs) Then pvOpenArgs = ""
 Set OpenForm = Nothing
 If Not (Utils._CheckArgument(pvFormName, 1, vbString) _
  And Utils._CheckArgument(pvView, 2, Utils._AddNumeric(), Array(acNormal, acPreview, acDesign)) _
  And Utils._CheckArgument(pvFilterName, 3, vbString) _
  And Utils._CheckArgument(pvWhereCondition, 4, vbString) _
  And Utils._CheckArgument(pvDataMode, 5, Utils._AddNumeric(), Array(acFormAdd, acFormEdit, acFormPropertySettings, acFormReadOnly)) _
  And Utils._CheckArgument(pvWindowMode, 6, Utils._AddNumeric(), Array(acDialog, acHidden, acIcon, acWindowNormal)) _
   ) Then Goto Exit_Function

Dim ofForm As Object, sWarning As String
Dim oDatabase As Object, oOpenForm As Object, bOpenMode As Boolean, oController As Object

 Set oDatabase = Application._CurrentDb()
 If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable

 Set ofForm = Application.AllForms(pvFormName)
 If ofForm.IsLoaded Then
  sWarning = _GetLabel("ERR" & ERRFORMYETOPEN)
  sWarning = Join(Split(sWarning, "%0"), ofForm._Name)
  TraceLog(TRACEANY, "OpenForm: " & sWarning)
  Set OpenForm = ofForm
  Goto Exit_Function
 End If
' Open the form
 Select Case pvView
  Case acNormal, acPreview: bOpenMode = False
  Case acDesign   : bOpenMode = True
 End Select
 Set oController = oDatabase.Document.CurrentController
 Set oOpenForm = oController.loadComponent(com.sun.star.sdb.application.DatabaseObject.FORM, ofForm._Name, bOpenMode)

' Apply the filters (FilterName) AND (WhereCondition)
Dim sFilter As String, oForm As Object, oFormsCollection As Object
 If pvFilterName = "" And pvWhereCondition = "" Then
  sFilter = ""
 ElseIf pvFilterName = "" Or pvWhereCondition = "" Then
  sFilter = pvFilterName & pvWhereCondition
 Else
  sFilter = "(" & pvFilterName & ") And (" & pvWhereCondition & ")"
 End If
 Set oFormsCollection = oOpenForm.DrawPage.Forms
 If oFormsCollection.getCount() > 0 Then Set oForm = oFormsCollection.getByIndex(0) Else Set oForm = Nothing
 If Not IsNull(oForm) Then
  If sFilter <> "" Then
   oForm.Filter = oDatabase._ReplaceSquareBrackets(sFilter)
   oForm.ApplyFilter = True
   oForm.reload()
  ElseIf oForm.Filter <> "" Then   ' If a filter has been set previously it must be removed
   oForm.Filter = ""
   oForm.ApplyFilter = False
   oForm.reload()
  End If
 End If

'Housekeeping
 Set ofForm = Application.AllForms(pvFormName)   ' Redone to reinitialize all properties of ofForm now FormName is open
 With ofForm
  If Not IsNull(.DatabaseForm) Then
   Select Case pvDataMode
    Case acFormAdd
     .AllowAdditions = True
     .AllowDeletions = False
     .AllowEdits = False
    Case acFormEdit
     .AllowAdditions = True
     .AllowDeletions = True
     .AllowEdits = True
    Case acFormReadOnly
     .AllowAdditions = False
     .AllowDeletions = False
     .AllowEdits = False
    Case acFormPropertySettings
   End Select
  End If
  .Visible = ( pvWindowMode <> acHidden )
  ._OpenArgs = pvOpenArgs
  'To avoid AOO 3.4 bug See http://user.services.openoffice.org/en/forum/viewtopic.php?f=13&t=53751
  .Component.CurrentController.ViewSettings.ShowOnlineLayout = True
 End With

 Set OpenForm = ofForm

Exit_Function:
 Utils._ResetCalledSub("OpenForm")
 Set ofForm = Nothing
 Set oOpenForm = Nothing
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "OpenForm", Erl)
 Set OpenForm = Nothing
 GoTo Exit_Function
Error_NotApplicable:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1)
 Goto Exit_Function
Trace_Error:
 TraceError(TRACEFATAL, ERROPENFORM, Utils._CalledSub(), 0, , pvFormName)
 Set OpenForm = Nothing
 Goto Exit_Function
End Function  ' OpenForm V0.9.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function OpenQuery(Optional ByVal pvQueryName As Variant _
   , Optional ByVal pvView As Variant _
   , Optional ByVal pvDataMode As Variant _
   ) As Boolean

 If _ErrorHandler() Then On Local Error Goto Error_Function

 Utils._SetCalledSub("OpenQuery")
 If IsMissing(pvQueryName) Then Call _TraceArguments()
 If IsMissing(pvView) Then pvView = acViewNormal
 If IsMissing(pvDataMode) Then pvDataMode = acEdit
 OpenQuery = DoCmd._OpenObject("Query", pvQueryName, pvView, pvDataMode)

Exit_Function:
 Utils._ResetCalledSub("OpenQuery")
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "OpenQuery", Erl)
 GoTo Exit_Function
End Function  ' OpenQuery

REM -----------------------------------------------------------------------------------------------------------------------
Public Function OpenReport(Optional ByVal pvReportName As Variant _
   , Optional ByVal pvView As Variant _
   , Optional ByVal pvDataMode As Variant _
   ) As Boolean

 If _ErrorHandler() Then On Local Error Goto Error_Function

 Utils._SetCalledSub("OpenReport")
 If IsMissing(pvReportName) Then Call _TraceArguments()
 If IsMissing(pvView) Then pvView = acViewNormal
 If IsMissing(pvDataMode) Then pvDataMode = acEdit
 OpenReport = DoCmd._OpenObject("Report", pvReportName, pvView, pvDataMode)

Exit_Function:
 Utils._ResetCalledSub("OpenReport")
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "OpenReport", Erl)
 GoTo Exit_Function
End Function  ' OpenReport

REM -----------------------------------------------------------------------------------------------------------------------
Public Function OpenSQL(Optional ByVal pvSQL As Variant _
      , Optional ByVal pvOption As Variant _
      ) As Boolean
' Return True if the execution of the SQL statement was successful
' SQL must contain a SELECT query
' pvOption can force pass through mode

 If _ErrorHandler() Then On Local Error Goto Error_Function

 Utils._SetCalledSub("OpenSQL")

 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(), dbSQLPassThrough) Then Goto Exit_Function
 End If

 OpenSQL = Application._CurrentDb.OpenSQL(pvSQL, pvOption)

Exit_Function:
 Utils._ResetCalledSub("OpenSQL")
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "OpenSQL", Erl)
 GoTo Exit_Function
End Function  ' OpenSQL  V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function OpenTable(Optional ByVal pvTableName As Variant _
   , Optional ByVal pvView As Variant _
   , Optional ByVal pvDataMode As Variant _
   ) As Boolean

 If _ErrorHandler() Then On Local Error Goto Error_Function

 Utils._SetCalledSub("OpenTable")
 If IsMissing(pvTableName) Then Call _TraceArguments()
 If IsMissing(pvView) Then pvView = acViewNormal
 If IsMissing(pvDataMode) Then pvDataMode = acEdit
 OpenTable = DoCmd._OpenObject("Table", pvTableName, pvView, pvDataMode)

Exit_Function:
 Utils._ResetCalledSub("OpenTable")
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "OpenTable", Erl)
 GoTo Exit_Function
End Function  ' OpenTable

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
REM https://wiki.openoffice.org/wiki/Framework/Article/Filter/FilterList_OOo_3_0
REM https://wiki.documentfoundation.org/Documentation/DevGuide/Spreadsheet_Documents#Filter_Options
REM https://msdn.microsoft.com/en-us/library/ms709353%28v=vs.85%29.aspx
'Supported: acFormatPDF, acFormatODT, acFormatDOC, acFormatHTML  for forms
'   acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT  for tables and queries

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "OutputTo"
 Utils._SetCalledSub(cstThisSub)

 OutputTo = False

 If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery, acOutputForm)) Then Goto Exit_Function
 If IsMissing(pvObjectName) Then pvObjectName = ""
 If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
 If IsMissing(pvOutputFormat) Then pvOutputFormat = ""
 If Not Utils._CheckArgument(pvOutputFormat, 3, vbString) Then Goto Exit_Function
 If pvOutputFormat <> "" Then
  If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _
   UCase(acFormatPDF), UCase(acFormatODT), UCase(acFormatDOC), UCase(acFormatHTML) _
   , UCase(acFormatODS), UCase(acFormatXLS), UCase(acFormatXLSX), UCase(acFormatTXT) _
   , "PDF", "ODT", "DOC", "HTML", "ODS", "XLS", "XLSX", "TXT", "CSV", "" _
   )) Then Goto Exit_Function    ' A 2nd time to allow case unsensitivity
 End If
 If IsMissing(pvOutputFile) Then pvOutputFile = ""
 If Not Utils._CheckArgument(pvOutputFile, 4, vbString) Then Goto Exit_Function
 If IsMissing(pvAutoStart) Then pvAutoStart = False
 If Not Utils._CheckArgument(pvAutoStart, 5, vbBoolean) Then Goto Exit_Function
 If IsMissing(pvTemplateFile) Then pvTemplateFile = ""
 If Not Utils._CheckArgument(pvTemplateFile, 6, vbString) Then Goto Exit_Function
 If IsMissing(pvEncoding) Then pvEncoding = 0
 If Not Utils._CheckArgument(pvEncoding, 7, _AddNumeric()) Then Goto Exit_Function
 If IsMissing(pvQuality) Then pvQuality = acExportQualityPrint
 If Not Utils._CheckArgument(pvQuality, 7, _AddNumeric(), Array(acExportQualityPrint, acExportQualityScreen)) Then Goto Exit_Function

 If pvObjectType = acOutputTable Or pvObjectType = acOutputQuery Then
  OutputTo = Application._CurrentDb().OutputTo( _
     pvObjectType _
     , pvObjectName _
     , pvOutputFormat _
     , pvOutputFile _
     , pvAutoStart _
     , pvTemplateFile _
     , pvEncoding _
     , pvQuality _
     )
  GoTo Exit_Function
 End If

Dim vWindow As Variant, sOutputFile As String, ofForm As Object, i As Integer, bFound As Boolean
 'Find applicable form
 If pvObjectName = "" Then
  vWindow = _SelectWindow()
  If vWindow.WindowType <> acOutoutForm Then Goto Error_Action
  Set ofForm = Application.Forms(vWindow._Name)
 Else
  bFound = False
  For i = 0 To Application.Forms()._Count - 1
   Set ofForm = Application.Forms(i)
   If UCase(ofForm._Name) = UCase(pvObjectName) Then
    bFound = True
    Exit For
   End If
  Next i
  If Not bFound Then Goto Error_NotFound
 End If

 'Determine format and parameters
Dim sOutputFormat As String, sFilter As String, oFilterData As Object, oExport As Object, sSuffix As String
 If pvOutputFormat = "" Then
  sOutputFormat = _PromptFormat(Array("PDF", "ODT", "DOC", "HTML"))   ' Prompt user for format
  If sOutputFormat = "" Then Goto Exit_Function
 Else
  sOutputFormat = UCase(pvOutputFormat)
 End If
 Select Case sOutputFormat
  Case UCase(acFormatPDF), "PDF"
   sFilter = acFormatPDF
   oFilterData = Array( _
       _MakePropertyValue ("ExportFormFields", False), _
       )
   sSuffix = "pdf"
  Case UCase(acFormatDOC), "DOC"
   sFilter = acFormatDOC
   oFilterData = Array()
   sSuffix = "doc"
  Case UCase(acFormatODT), "ODT"
   sFilter = acFormatODT
   oFilterData = Array()
   sSuffix = "odt"
  Case UCase(acFormatHTML), "HTML"
   sFilter = acFormatHTML
   oFilterData = Array()
   sSuffix = "html"
 End Select
 oExport = Array( _
     _MakePropertyValue("Overwrite", True), _
  _MakePropertyValue("FilterName", sFilter), _
  _MakePropertyValue("FilterData", oFilterData), _
  )

 'Determine output file
 If pvOutputFile = "" Then   ' Prompt file picker to user
  sOutputFile = _PromptFilePicker(sSuffix)
  If sOutputFile = "" Then Goto Exit_Function
 Else
  sOutputFile = pvOutputFile
 End If
 sOutputFile = ConvertToURL(sOutputFile)

 'Create file
 On Local Error Goto Error_File
 ofForm.Component.storeToURL(sOutputFile, oExport)
 On Local Error Goto Error_Function

 'Launch application, if requested
 If pvAutoStart Then Call _ShellExecute(sOutputFile)

 OutputTo = True

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_NotFound:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName))
 Goto Exit_Function
Error_Action:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0)
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
Error_File:
 TraceError(TRACEFATAL, ERRFILENOTCREATED, Utils._CalledSub(), 0, , sOutputFile)
 GoTo Exit_Function
End Function  ' OutputTo  V0.9.1

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Quit(Optional ByVal pvSave As Variant) As Variant
' Quit the application
' Modified from Andrew Pitonyak's Base Macro Programming §5.8.1

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "Quit"
 Utils._SetCalledSub(cstThisSub)

 If IsMissing(pvSave) Then pvSave = acQuitSaveAll
 If Not Utils._CheckArgument(pvSave, 1, Utils._AddNumeric(), _
   Array(acQuitPrompt, acQuitSaveAll, acQuitSaveNone) _
   ) Then Goto Exit_Function

Dim oDatabase As Object, oDoc As Object
 Set oDatabase = Application._CurrentDb()
 If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
 If Not IsNull(oDatabase) Then
  Set oDoc = oDatabase.Document
  Select Case pvSave
   Case acQuitPrompt
    If MsgBox(_GetLabel("QUIT"), vbYesNo + vbQuestion, _GetLabel("QUITSHORT")) = vbNo Then Exit Function
   Case acQuitSaveNone
    oDoc.setModified(False)
   Case Else
  End Select
  If HasUnoInterfaces(oDoc, "com.sun.star.util.XCloseable") Then
   If (oDoc.isModified) Then
    If (oDoc.hasLocation AND (Not oDoc.isReadOnly)) Then
     oDoc.store()
    End If
   End If
   oDoc.close(true)
  Else
   oDoc.dispose()
  End If
 End If

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Set oDatabase = Nothing
 Set oDoc = Nothing
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
 Set OpenForm = Nothing
 GoTo Exit_Function
Error_NotApplicable:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
 Goto Exit_Function
End Function  ' Quit V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub RunApp(Optional ByVal pvCommandLine As Variant)
' Convert to URL and execute the Command Line

 If _ErrorHandler() Then On Local Error Goto Error_Sub

 Utils._SetCalledSub("RunApp")

 If IsMissing(pvCommandLine) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvCommandLine, 1, vbString) Then Goto Exit_Sub

 _ShellExecute(ConvertToURL(pvCommandLine))

Exit_Sub:
 Utils._ResetCalledSub("RunApp")
 Exit Sub
Error_Sub:
 TraceError(TRACEABORT, Err, "RunApp", Erl)
 GoTo Exit_Sub
End Sub    ' RunApp  V0.8.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function RunCommand(Optional pvCommand As Variant, Optional pbReturnCommand As Boolean) As Variant
' Execute command via DispatchHelper
' pbReturnCommand = internal parameter to only return the exact command string (always absent if uno prefix present in pvCommand)

 If _ErrorHandler() Then On Local Error Goto Exit_Function   ' Avoid any abort
Const cstThisSub = "RunCommand"
 Utils._SetCalledSub(cstThisSub)

Dim iVBACommand As Integer, sOOCommand As String, sDispatch As String
 If IsMissing(pvCommand) Then Call _TraceArguments()
 If Not ( Utils._CheckArgument(pvCommand, 1, Utils._AddNumeric(vbString)) ) Then Goto Exit_Function
 If IsMissing(pbReturnCommand) Then pbReturnCommand = False

 RunCommand = True

Const cstUnoPrefix = ".uno:"
 If VarType(pvCommand) = vbString Then
  sOOCommand = pvCommand
  iVBACommand = -1
  If _IsLeft(sOOCommand, cstUnoPrefix) Then
   Call _DispatchCommand(sOOCommand)
   Goto Exit_Function
  End If
 Else
  sOOCommand = ""
  iVBACommand = pvCommand
 End If

 Select Case True
  Case iVBACommand = acCmdAboutMicrosoftAccess  Or UCase(sOOCommand) = "ABOUT" : sDispatch = "About"
  Case iVBACommand = acCmdAboutOpenOffice Or UCase(sOOCommand) = "ABOUT" : sDispatch = "About"
  Case iVBACommand = acCmdAboutLibreOffice Or UCase(sOOCommand) = "ABOUT" : sDispatch = "About"
  Case UCase(sOOCommand) = "ACTIVEHELP" : sDispatch = "ActiveHelp"
  Case UCase(sOOCommand) = "ADDDIRECT" : sDispatch = "AddDirect"
  Case UCase(sOOCommand) = "ADDFIELD" : sDispatch = "AddField"
  Case UCase(sOOCommand) = "AUTOCONTROLFOCUS" : sDispatch = "AutoControlFocus"
  Case UCase(sOOCommand) = "AUTOFILTER" : sDispatch = "AutoFilter"
  Case UCase(sOOCommand) = "AUTOPILOTADDRESSDATASOURCE" : sDispatch = "AutoPilotAddressDataSource"
  Case UCase(sOOCommand) = "BASICBREAK" : sDispatch = "BasicBreak"
  Case iVBACommand = acCmdVisualBasicEditor  Or UCase(sOOCommand) = "BASICIDEAPPEAR" : sDispatch = "BasicIDEAppear"
  Case UCase(sOOCommand) = "BASICSTOP" : sDispatch = "BasicStop"
  Case iVBACommand = acCmdBringToFront  Or UCase(sOOCommand) = "BRINGTOFRONT" : sDispatch = "BringToFront"
  Case UCase(sOOCommand) = "CHECKBOX" : sDispatch = "CheckBox"
  Case UCase(sOOCommand) = "CHOOSEMACRO" : sDispatch = "ChooseMacro"
  Case iVBACommand = acCmdClose  Or UCase(sOOCommand) = "CLOSEDOC" : sDispatch = "CloseDoc"
  Case UCase(sOOCommand) = "CLOSEWIN" : sDispatch = "CloseWin"
  Case iVBACommand = acCmdToolbarsCustomize  Or UCase(sOOCommand) = "CONFIGUREDIALOG" : sDispatch = "ConfigureDialog"
  Case UCase(sOOCommand) = "CONTROLPROPERTIES" : sDispatch = "ControlProperties"
  Case iVBACommand = acCmdChangeToCommandButton  Or UCase(sOOCommand) = "CONVERTTOBUTTON" : sDispatch = "ConvertToButton"
  Case iVBACommand = acCmdChangeToCheckBox  Or UCase(sOOCommand) = "CONVERTTOCHECKBOX" : sDispatch = "ConvertToCheckBox"
  Case iVBACommand = acCmdChangeToComboBox  Or UCase(sOOCommand) = "CONVERTTOCOMBO" : sDispatch = "ConvertToCombo"
  Case UCase(sOOCommand) = "CONVERTTOCURRENCY" : sDispatch = "ConvertToCurrency"
  Case UCase(sOOCommand) = "CONVERTTODATE" : sDispatch = "ConvertToDate"
  Case iVBACommand = acCmdChangeToTextBox  Or UCase(sOOCommand) = "CONVERTTOEDIT" : sDispatch = "ConvertToEdit"
  Case UCase(sOOCommand) = "CONVERTTOFILECONTROL" : sDispatch = "ConvertToFileControl"
  Case iVBACommand = acCmdChangeToLabel  Or UCase(sOOCommand) = "CONVERTTOFIXED" : sDispatch = "ConvertToFixed"
  Case UCase(sOOCommand) = "CONVERTTOFORMATTED" : sDispatch = "ConvertToFormatted"
  Case UCase(sOOCommand) = "CONVERTTOGROUP" : sDispatch = "ConvertToGroup"
  Case UCase(sOOCommand) = "CONVERTTOIMAGEBTN" : sDispatch = "ConvertToImageBtn"
  Case iVBACommand = acCmdChangeToImage  Or UCase(sOOCommand) = "CONVERTTOIMAGECONTROL" : sDispatch = "ConvertToImageControl"
  Case iVBACommand = acCmdChangeToListBox  Or UCase(sOOCommand) = "CONVERTTOLIST" : sDispatch = "ConvertToList"
  Case UCase(sOOCommand) = "CONVERTTONAVIGATIONBAR" : sDispatch = "ConvertToNavigationBar"
  Case UCase(sOOCommand) = "CONVERTTONUMERIC" : sDispatch = "ConvertToNumeric"
  Case UCase(sOOCommand) = "CONVERTTOPATTERN" : sDispatch = "ConvertToPattern"
  Case iVBACommand = acCmdChangeToOptionButton  Or UCase(sOOCommand) = "CONVERTTORADIO" : sDispatch = "ConvertToRadio"
  Case UCase(sOOCommand) = "CONVERTTOSCROLLBAR" : sDispatch = "ConvertToScrollBar"
  Case UCase(sOOCommand) = "CONVERTTOSPINBUTTON" : sDispatch = "ConvertToSpinButton"
  Case UCase(sOOCommand) = "CONVERTTOTIME" : sDispatch = "ConvertToTime"
  Case iVBACommand = acCmdCopy  Or UCase(sOOCommand) = "COPY" : sDispatch = "Copy"
  Case UCase(sOOCommand) = "CURRENCYFIELD" : sDispatch = "CurrencyField"
  Case iVBACommand = acCmdCut  Or UCase(sOOCommand) = "CUT" : sDispatch = "Cut"
  Case UCase(sOOCommand) = "DATEFIELD" : sDispatch = "DateField"
  Case iVBACommand = acCmdCreateRelationship  Or UCase(sOOCommand) = "DBADDRELATION " : sDispatch = "DBAddRelation "
  Case UCase(sOOCommand) = "DBCONVERTTOVIEW " : sDispatch = "DBConvertToView "
  Case iVBACommand = acCmdDelete  Or UCase(sOOCommand) = "DBDELETE " : sDispatch = "DBDelete "
  Case UCase(sOOCommand) = "DBDIRECTSQL " : sDispatch = "DBDirectSQL "
  Case UCase(sOOCommand) = "DBDSADVANCEDSETTINGS " : sDispatch = "DBDSAdvancedSettings "
  Case UCase(sOOCommand) = "DBDSCONNECTIONTYPE " : sDispatch = "DBDSConnectionType "
  Case iVBACommand = acCmdDatabaseProperties  Or UCase(sOOCommand) = "DBDSPROPERTIES " : sDispatch = "DBDSProperties "
  Case UCase(sOOCommand) = "DBEDIT " : sDispatch = "DBEdit "
  Case iVBACommand = acCmdSQLView  Or UCase(sOOCommand) = "DBEDITSQLVIEW " : sDispatch = "DBEditSqlView "
  Case iVBACommand = acCmdRemove  Or UCase(sOOCommand) = "DBFORMDELETE " : sDispatch = "DBFormDelete "
  Case iVBACommand = acCmdDesignView  Or UCase(sOOCommand) = "DBFORMEDIT " : sDispatch = "DBFormEdit "
  Case iVBACommand = acCmdFormView  Or UCase(sOOCommand) = "DBFORMOPEN " : sDispatch = "DBFormOpen "
  Case UCase(sOOCommand) = "DBFORMRENAME " : sDispatch = "DBFormRename "
  Case iVBACommand = acCmdNewObjectForm  Or UCase(sOOCommand) = "DBNEWFORM " : sDispatch = "DBNewForm "
  Case UCase(sOOCommand) = "DBNEWFORMAUTOPILOT " : sDispatch = "DBNewFormAutoPilot "
  Case UCase(sOOCommand) = "DBNEWQUERY " : sDispatch = "DBNewQuery "
  Case UCase(sOOCommand) = "DBNEWQUERYAUTOPILOT " : sDispatch = "DBNewQueryAutoPilot "
  Case UCase(sOOCommand) = "DBNEWQUERYSQL " : sDispatch = "DBNewQuerySql "
  Case UCase(sOOCommand) = "DBNEWREPORT " : sDispatch = "DBNewReport "
  Case UCase(sOOCommand) = "DBNEWREPORTAUTOPILOT " : sDispatch = "DBNewReportAutoPilot "
  Case iVBACommand = acCmdNewObjectTable  Or UCase(sOOCommand) = "DBNEWTABLE " : sDispatch = "DBNewTable "
  Case UCase(sOOCommand) = "DBNEWTABLEAUTOPILOT " : sDispatch = "DBNewTableAutoPilot "
  Case iVBACommand = acCmdNewObjectView  Or UCase(sOOCommand) = "DBNEWVIEW " : sDispatch = "DBNewView "
  Case UCase(sOOCommand) = "DBNEWVIEWSQL " : sDispatch = "DBNewViewSQL "
  Case iVBACommand = acCmdOpenDatabase  Or UCase(sOOCommand) = "DBOPEN " : sDispatch = "DBOpen "
  Case iVBACommand = acCmdRemove  Or UCase(sOOCommand) = "DBQUERYDELETE " : sDispatch = "DBQueryDelete "
  Case iVBACommand = acCmdDesignView  Or UCase(sOOCommand) = "DBQUERYEDIT " : sDispatch = "DBQueryEdit "
  Case iVBACommand = acCmdNewObjectQuery  Or UCase(sOOCommand) = "DBQUERYOPEN " : sDispatch = "DBQueryOpen "
  Case UCase(sOOCommand) = "DBQUERYRENAME " : sDispatch = "DBQueryRename "
  Case UCase(sOOCommand) = "DBREFRESHTABLES " : sDispatch = "DBRefreshTables "
  Case iVBACommand = acCmdShowAllRelationships  Or UCase(sOOCommand) = "DBRELATIONDESIGN " : sDispatch = "DBRelationDesign "
  Case UCase(sOOCommand) = "DBRENAME " : sDispatch = "DBRename "
  Case iVBACommand = acCmdRemove  Or UCase(sOOCommand) = "DBREPORTDELETE " : sDispatch = "DBReportDelete "
  Case iVBACommand = acCmdDesignView  Or UCase(sOOCommand) = "DBREPORTEDIT " : sDispatch = "DBReportEdit "
  Case iVBACommand = acCmdNewObjectReport  Or UCase(sOOCommand) = "DBREPORTOPEN " : sDispatch = "DBReportOpen "
  Case UCase(sOOCommand) = "DBREPORTRENAME " : sDispatch = "DBReportRename "
  Case iVBACommand = acCmdSelectAll  Or UCase(sOOCommand) = "DBSELECTALL " : sDispatch = "DBSelectAll "
  Case UCase(sOOCommand) = "DBSHOWDOCINFOPREVIEW " : sDispatch = "DBShowDocInfoPreview "
  Case UCase(sOOCommand) = "DBSHOWDOCPREVIEW " : sDispatch = "DBShowDocPreview "
  Case iVBACommand = acCmdRemoveTable  Or UCase(sOOCommand) = "DBTABLEDELETE " : sDispatch = "DBTableDelete "
  Case iVBACommand = acCmdDesignView  Or UCase(sOOCommand) = "DBTABLEEDIT " : sDispatch = "DBTableEdit "
  Case UCase(sOOCommand) = "DBTABLEFILTER " : sDispatch = "DBTableFilter "
  Case iVBACommand = acCmdOpenTable  Or UCase(sOOCommand) = "DBTABLEOPEN " : sDispatch = "DBTableOpen "
  Case iVBACommand = acCmdRename  Or UCase(sOOCommand) = "DBTABLERENAME " : sDispatch = "DBTableRename "
  Case UCase(sOOCommand) = "DBUSERADMIN " : sDispatch = "DBUserAdmin "
  Case UCase(sOOCommand) = "DBVIEWFORMS " : sDispatch = "DBViewForms "
  Case UCase(sOOCommand) = "DBVIEWQUERIES " : sDispatch = "DBViewQueries "
  Case UCase(sOOCommand) = "DBVIEWREPORTS " : sDispatch = "DBViewReports "
  Case UCase(sOOCommand) = "DBVIEWTABLES " : sDispatch = "DBViewTables "
  Case iVBACommand = acCmdDelete  Or UCase(sOOCommand) = "DELETE" : sDispatch = "Delete"
  Case iVBACommand = acCmdDeleteRecord  Or UCase(sOOCommand) = "DELETERECORD" : sDispatch = "DeleteRecord"
  Case UCase(sOOCommand) = "DESIGNERDIALOG" : sDispatch = "DesignerDialog"
  Case UCase(sOOCommand) = "EDIT" : sDispatch = "Edit"
  Case UCase(sOOCommand) = "FIRSTRECORD" : sDispatch = "FirstRecord"
  Case UCase(sOOCommand) = "FONTDIALOG" : sDispatch = "FontDialog"
  Case UCase(sOOCommand) = "FONTHEIGHT" : sDispatch = "FontHeight"
  Case UCase(sOOCommand) = "FORMATTEDFIELD" : sDispatch = "FormattedField"
  Case UCase(sOOCommand) = "FORMFILTER" : sDispatch = "FormFilter"
  Case iVBACommand = acCmdApplyFilterSort  Or UCase(sOOCommand) = "FORMFILTERED" : sDispatch = "FormFiltered"
  Case UCase(sOOCommand) = "FORMFILTEREXECUTE" : sDispatch = "FormFilterExecute"
  Case UCase(sOOCommand) = "FORMFILTEREXIT" : sDispatch = "FormFilterExit"
  Case UCase(sOOCommand) = "FORMFILTERNAVIGATOR" : sDispatch = "FormFilterNavigator"
  Case UCase(sOOCommand) = "FORMPROPERTIES" : sDispatch = "FormProperties"
  Case UCase(sOOCommand) = "FULLSCREEN" : sDispatch = "FullScreen"
  Case UCase(sOOCommand) = "GALLERY" : sDispatch = "Gallery"
  Case UCase(sOOCommand) = "GRID" : sDispatch = "Grid"
  Case iVBACommand = acCmdSnapToGrid  Or UCase(sOOCommand) = "GRIDUSE" : sDispatch = "GridUse"
  Case iVBACommand = acCmdViewGrid  Or UCase(sOOCommand) = "GRIDVISIBLE" : sDispatch = "GridVisible"
  Case UCase(sOOCommand) = "GROUPBOX" : sDispatch = "GroupBox"
  Case UCase(sOOCommand) = "HELPINDEX" : sDispatch = "HelpIndex"
  Case UCase(sOOCommand) = "HELPSUPPORT" : sDispatch = "HelpSupport"
  Case iVBACommand = acCmdInsertHyperlink  Or UCase(sOOCommand) = "HYPERLINKDIALOG" : sDispatch = "HyperlinkDialog"
  Case UCase(sOOCommand) = "IMAGEBUTTON" : sDispatch = "Imagebutton"
  Case UCase(sOOCommand) = "IMAGECONTROL" : sDispatch = "ImageControl"
  Case UCase(sOOCommand) = "LABEL" : sDispatch = "Label"
  Case iVBACommand = acCmdMaximumRecords  Or UCase(sOOCommand) = "LASTRECORD" : sDispatch = "LastRecord"
  Case UCase(sOOCommand) = "LISTBOX" : sDispatch = "ListBox"
  Case UCase(sOOCommand) = "MACRODIALOG" : sDispatch = "MacroDialog"
  Case UCase(sOOCommand) = "MACROORGANIZER" : sDispatch = "MacroOrganizer"
  Case UCase(sOOCommand) = "NAVIGATIONBAR" : sDispatch = "NavigationBar"
  Case iVBACommand = acCmdObjectBrowser  Or UCase(sOOCommand) = "NAVIGATOR" : sDispatch = "Navigator"
  Case UCase(sOOCommand) = "NEWDOC" : sDispatch = "NewDoc"
  Case UCase(sOOCommand) = "NEWRECORD" : sDispatch = "NewRecord"
  Case UCase(sOOCommand) = "NEXTRECORD" : sDispatch = "NextRecord"
  Case UCase(sOOCommand) = "NUMERICFIELD" : sDispatch = "NumericField"
  Case UCase(sOOCommand) = "OPEN" : sDispatch = "Open"
  Case UCase(sOOCommand) = "OPTIONSTREEDIALOG" : sDispatch = "OptionsTreeDialog"
  Case UCase(sOOCommand) = "ORGANIZER" : sDispatch = "Organizer"
  Case UCase(sOOCommand) = "PARAGRAPHDIALOG" : sDispatch = "ParagraphDialog"
  Case iVBACommand = acCmdPaste  Or UCase(sOOCommand) = "PASTE" : sDispatch = "Paste"
  Case iVBACommand = acCmdPasteSpecial  Or UCase(sOOCommand) = "PASTESPECIAL " : sDispatch = "PasteSpecial "
  Case UCase(sOOCommand) = "PATTERNFIELD" : sDispatch = "PatternField"
  Case UCase(sOOCommand) = "PREVRECORD" : sDispatch = "PrevRecord"
  Case iVBACommand = acCmdPrint  Or UCase(sOOCommand) = "PRINT" : sDispatch = "Print"
  Case UCase(sOOCommand) = "PRINTDEFAULT" : sDispatch = "PrintDefault"
  Case UCase(sOOCommand) = "PRINTERSETUP" : sDispatch = "PrinterSetup"
  Case iVBACommand = acCmdPrintPreview  Or UCase(sOOCommand) = "PRINTPREVIEW" : sDispatch = "PrintPreview"
  Case UCase(sOOCommand) = "PUSHBUTTON" : sDispatch = "Pushbutton"
  Case UCase(sOOCommand) = "QUIT" : sDispatch = "Quit"
  Case UCase(sOOCommand) = "RADIOBUTTON" : sDispatch = "RadioButton"
  Case iVBACommand = acCmdSaveRecord  Or UCase(sOOCommand) = "RECSAVE" : sDispatch = "RecSave"
  Case iVBACommand = acCmdFind  Or UCase(sOOCommand) = "RECSEARCH" : sDispatch = "RecSearch"
  Case iVBACommand = acCmdUndo  Or UCase(sOOCommand) = "RECUNDO" : sDispatch = "RecUndo"
  Case iVBACommand = acCmdRefresh  Or UCase(sOOCommand) = "REFRESH" : sDispatch = "Refresh"
  Case UCase(sOOCommand) = "RELOAD" : sDispatch = "Reload"
  Case iVBACommand = acCmdRemoveFilterSort  Or UCase(sOOCommand) = "REMOVEFILTERSORT" : sDispatch = "RemoveFilterSort"
  Case iVBACommand = acCmdRunMacro  Or UCase(sOOCommand) = "RUNMACRO" : sDispatch = "RunMacro"
  Case iVBACommand = acCmdSave  Or UCase(sOOCommand) = "SAVE" : sDispatch = "Save"
  Case UCase(sOOCommand) = "SAVEALL" : sDispatch = "SaveAll"
  Case iVBACommand = acCmdSaveAs  Or UCase(sOOCommand) = "SAVEAS" : sDispatch = "SaveAs"
  Case UCase(sOOCommand) = "SAVEBASICAS" : sDispatch = "SaveBasicAs"
  Case UCase(sOOCommand) = "SCRIPTORGANIZER" : sDispatch = "ScriptOrganizer"
  Case UCase(sOOCommand) = "SCROLLBAR" : sDispatch = "ScrollBar"
  Case iVBACommand = acCmdFind  Or UCase(sOOCommand) = "SEARCHDIALOG" : sDispatch = "SearchDialog"
  Case iVBACommand = acCmdSelectAll  Or UCase(sOOCommand) = "SELECTALL" : sDispatch = "SelectAll"
  Case iVBACommand = acCmdSelectAllRecords  Or UCase(sOOCommand) = "SELECTALL" : sDispatch = "SelectAll"
  Case iVBACommand = acCmdSendToBack  Or UCase(sOOCommand) = "SENDTOBACK" : sDispatch = "SendToBack"
  Case UCase(sOOCommand) = "SHOWFMEXPLORER" : sDispatch = "ShowFmExplorer"
  Case UCase(sOOCommand) = "SIDEBAR" : sDispatch = "Sidebar"
  Case iVBACommand = acCmdSortDescending  Or UCase(sOOCommand) = "SORTDOWN" : sDispatch = "SortDown"
  Case iVBACommand = acCmdSortAscending  Or UCase(sOOCommand) = "SORTUP" : sDispatch = "Sortup"
  Case UCase(sOOCommand) = "SPINBUTTON" : sDispatch = "SpinButton"
  Case UCase(sOOCommand) = "STATUSBARVISIBLE" : sDispatch = "StatusBarVisible"
  Case UCase(sOOCommand) = "SWITCHCONTROLDESIGNMODE" : sDispatch = "SwitchControlDesignMode"
  Case iVBACommand = acCmdTabOrder  Or UCase(sOOCommand) = "TABDIALOG" : sDispatch = "TabDialog"
  Case UCase(sOOCommand) = "USEWIZARDS" : sDispatch = "UseWizards"
  Case UCase(sOOCommand) = "VERSIONDIALOG" : sDispatch = "VersionDialog"
  Case UCase(sOOCommand) = "VIEWDATASOURCEBROWSER" : sDispatch = "ViewDataSourceBrowser"
  Case iVBACommand = acCmdDatasheetView  Or UCase(sOOCommand) = "VIEWFORMASGRID" : sDispatch = "ViewFormAsGrid"
  Case iVBACommand = acCmdZoomSelection  Or UCase(sOOCommand) = "ZOOM" : sDispatch = "Zoom"
  Case Else
   If iVBACommand >= 0 Then Goto Exit_Function
   sDispatch = pvCommand
 End Select

 If pbReturnCommand Then RunCommand = cstUnoPrefix & sDispatch Else Call _DispatchCommand(cstUnoPrefix & sDispatch)

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
 GoTo Exit_Function
End Function ' RunCommand V0.7.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function RunSQL(Optional ByVal pvSQL As Variant _
      , Optional ByVal pvOption As Variant _
      ) As Boolean
' Return True if the execution of the SQL statement was successful
' SQL must contain an ACTION query

 If _ErrorHandler() Then On Local Error Goto Error_Function

 Utils._SetCalledSub("RunSQL")

 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

 RunSQL = Application._CurrentDb.RunSQL(pvSQL, pvOption)

Exit_Function:
 Utils._ResetCalledSub("RunSQL")
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "RunSQL", Erl)
 GoTo Exit_Function
End Function  ' RunSQL  V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function SelectObject( ByVal Optional pvObjectType As Variant _
        , ByVal Optional pvObjectName As Variant _
        , ByVal Optional pvInDatabaseWindow As Variant _
        ) As Boolean

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "SelectObject"
 Utils._SetCalledSub(cstThisSub)

 If IsMissing(pvObjectType) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _
   Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow, acDocument) _
   ) Then Goto Exit_Function
 If IsMissing(pvObjectName) Then
  Select Case pvObjectType
   Case acForm, acQuery, acTable, acReport, acDocument  : Call _TraceArguments()
   Case Else
  End Select
  pvObjectName = ""
 Else
  If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
 End If
 If Not IsMissing(pvInDatabaseWindow) Then
  If Not Utils._CheckArgument(pvInDatabaseWindow, 3, vbBoolean, False) Then Goto Exit_Function
 End If

Dim oWindow As Object
 Set oWindow = _SelectWindow(pvObjectType, pvObjectName)
 If IsNull(oWindow.Frame) Then Goto Error_NotFound
 With oWindow.Frame.ContainerWindow
  If .isVisible() = False Then .setVisible(True)
  .IsMinimized = False
  .setFocus()
  .setEnable(True)  ' Added to try to bypass desynchro issue in Linux
  .toFront()    ' Added to force window change in Linux
 End With

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_NotFound:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName))
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
End Function  ' SelectObject V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function SendObject(ByVal Optional pvObjectType As Variant _
       , ByVal Optional pvObjectName As Variant _
       , ByVal Optional pvOutputFormat As Variant _
       , ByVal Optional pvTo As Variant _
       , ByVal Optional pvCc As Variant _
       , ByVal Optional pvBcc As Variant _
       , ByVal Optional pvSubject As Variant _
       , ByVal Optional pvMessageText As Variant _
       , ByVal Optional pvEditMessage As Variant _
       , ByVal Optional pvTemplateFile As Variant _
       ) As Boolean
'Supported: acFormatPDF, acFormatODT, acFormatDOC, acFormatHTML for forms
'To be prepared: acFormatCSV and acFormatODS for tables/queries ?
 If _ErrorHandler() Then On Local Error Goto Error_Function
 Utils._SetCalledSub("SendObject")
 SendObject = False

 If IsMissing(pvObjectType) Then pvObjectType = acSendNoObject
 If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acSendNoObject, acSendForm)) Then Goto Exit_Function
 If IsMissing(pvObjectName) Then pvObjectName = ""
 If Not Utils._CheckArgument(pvObjectName, 2,vbString) Then Goto Exit_Function
 If IsMissing(pvOutputFormat) Then pvOutputFormat = ""
 If Not Utils._CheckArgument(pvOutputFormat, 3, vbString) Then Goto Exit_Function
 If pvOutputFormat <> "" Then
  If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _
   UCase(acFormatPDF), UCase(acFormatODT), UCase(acFormatDOC), UCase(acFormatHTML) _
   , "PDF", "ODT", "DOC", "HTML", "" _
   )) Then Goto Exit_Function    ' A 2nd time to allow case unsensitivity
 End If
 If IsMissing(pvTo) Then pvTo = ""
 If Not Utils._CheckArgument(pvTo, 4, vbString) Then Goto Exit_Function
 If IsMissing(pvCc) Then pvCc = ""
 If Not Utils._CheckArgument(pvCc, 5, vbString) Then Goto Exit_Function
 If IsMissing(pvBcc) Then pvBcc = ""
 If Not Utils._CheckArgument(pvBcc, 6, vbString) Then Goto Exit_Function
 If IsMissing(pvSubject) Then pvSubject = ""
 If Not Utils._CheckArgument(pvSubject, 7, vbString) Then Goto Exit_Function
 If IsMissing(pvMessageText) Then pvMessageText = ""
 If Not Utils._CheckArgument(pvMessageText, 8, vbString) Then Goto Exit_Function
 If IsMissing(pvEditMessage) Then pvEditMessage = True
 If Not Utils._CheckArgument(pvEditMessage, 9, vbBoolean) Then Goto Exit_Function
 If IsMissing(pvTemplateFile) Then pvTemplateFile = ""
 If Not Utils._CheckArgument(pvTemplateFile, 10, vbString, "") Then Goto Exit_Function

Dim vTo() As Variant, vCc() As Variant, vBcc() As Variant, oWindow As Object
Dim sDirectory As String, sOutputFile As String, sSuffix As String, sOutputFormat As String
Const cstSemiColon = ";"
 If pvTo <> "" Then vTo() = Split(pvTo, cstSemiColon) Else vTo() = Array()
 If pvCc <> "" Then vCc() = Split(pvCc, cstSemiColon) Else vCc() = Array()
 If pvBcc <> "" Then vBcc() = Split(pvBcc, cstSemiColon) Else vBcc() = Array()
 Select Case True
  Case pvObjectType = acSendNoObject And pvObjectName = ""
   SendObject = _SendWithoutAttachment(vTo, vCc, vBcc, pvSubject, pvMessageText)
  Case Else
   If pvObjectType = acSendNoObject And pvObjectName <> "" Then
    If Not FileExists(pvObjectName) Then Goto Error_File
    sOutputFile = pvObjectName
   Else       ' OutputFile has to be created
    If pvObjectType <> acSendNoObject And pvObjectName = "" Then
     oWindow = _SelectWindow()
     If oWindow.WindowType <> acSendForm Then Goto Error_Action
     pvObjectType = acSendForm
     pvObjectName = oWindow._Name
    End If
    sDirectory =  Utils._getTempDirectoryURL()
    If Right(sDirectory, 1) <> "/" Then sDirectory = sDirectory & "/"
    If pvOutputFormat = "" Then
     sOutputFormat = _PromptFormat(Array("PDF", "ODT", "DOC", "HTML"))   ' Prompt user for format
     If sOutputFormat = "" Then Goto Exit_Function
    Else
     sOutputFormat = UCase(pvOutputFormat)
    End If
    Select Case sOutputFormat
     Case UCase(acFormatPDF), "PDF"  :  sSuffix = "pdf"
     Case UCase(acFormatDOC), "DOC"  :  sSuffix = "doc"
     Case UCase(acFormatODT), "ODT"  :  sSuffix = "odt"
     Case UCase(acFormatHTML), "HTML"  :  sSuffix = "html"
    End Select
    sOutputFile = sDirectory & pvObjectName & "." & sSuffix
    If Not OutputTo(pvObjectType, pvObjectName, sOutputFormat, sOutputFile, False) Then Goto Exit_Function
   End If
   SendObject = _SendWithAttachment(vTo, vCc, vBcc, pvSubject, Array(sOutputFile), pvMessageText, pvEditMessage)
 End Select

Exit_Function:
 Utils._ResetCalledSub("SendObject")
 Exit Function
Error_NotFound:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName))
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, "SendObject", Erl)
 GoTo Exit_Function
Error_Action:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0)
 Goto Exit_Function
Error_File:
 TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , pvObjectName)
 Goto Exit_Function
End Function  ' SendObject  V0.8.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function SetHiddenAttribute(ByVal Optional pvObjectType As Variant _
        , ByVal Optional pvObjectName As Variant _
        , ByVal Optional pvHidden As Variant _
        ) As Boolean

 If _ErrorHandler() Then On Local Error Goto Error_Function
 SetHiddenAttribute = False
Const cstThisSub = "SetHiddenAttribute"
 Utils._SetCalledSub(cstThisSub)

 If IsMissing(pvObjectType) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _
   Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow), acDocument _
   ) Then Goto Exit_Function
 If IsMissing(pvObjectName) Then
  Select Case pvObjectType
   Case acForm, acQuery, acTable, acReport, acDocument  : Call _TraceArguments()
   Case Else
  End Select
  pvObjectName = ""
 Else
  If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
 End If
 If IsMissing(pvHidden) Then
  pvHidden = True
 Else
  If Not Utils._CheckArgument(pvHidden, 3, vbBoolean) Then Goto Exit_Function
 End If

Dim oWindow As Object
 Set oWindow = _SelectWindow(pvObjectType, pvObjectName)
 If IsNull(oWindow.Frame) Then Goto Error_NotFound
 oWindow.Frame.ContainerWindow.setVisible(Not pvHidden)
 SetHiddenAttribute = True

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_NotFound:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName))
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
End Function  ' SetHiddenAttribute V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function SetOrderBy( _
     ByVal Optional pvOrder As Variant _
     , ByVal Optional pvControlName As Variant _
     ) As Boolean
' Sort ann open table, query, form or subform (if pvControlName present)

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "SetOrderBy"
 Utils._SetCalledSub(cstThisSub)
 SetOrderBy = False

 If IsMissing(pvOrder) Then pvOrder = ""
 If Not Utils._CheckArgument(pvOrder, 1, vbString) Then Goto Exit_Function
 If IsMissing(pvControlName) Then pvControlName = ""
 If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function

Dim sOrder As String, oWindow As Object, oDatabase As Object, oTarget As Object
 Set oDatabase = Application._CurrentDb()
 If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable

 sOrder = oDatabase._ReplaceSquareBrackets(pvOrder)

 Set oWindow = _SelectWindow()
 With oWindow
  Select Case .WindowType
   Case acForm
    Set oTarget = _DatabaseForm(._Name, pvControlName)
   Case acQuery, acTable
    If pvControlName <> "" Then Goto Exit_Function
    If IsNull(.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
      ' FormOperations returns <Null> in OpenOffice
    Set oTarget = .Frame.Controller.FormOperations.Cursor
   Case Else  ' Ignore action
    Goto Exit_Function
  End Select
 End With

 With oTarget
  .Order = sOrder
  .reload()
 End With
 SetOrderBy = True

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_NotApplicable:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
End Function  ' SetOrderBy V1.2.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function ShowAllrecords() As Boolean
' Removes any existing filter that exists on the current table, query or form

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "ShowAllRecords"
 Utils._SetCalledSub(cstThisSub)
 ShowAllRecords = False

Dim oWindow As Object, oDatabase As Object
 Set oDatabase = Application._CurrentDb()
 If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable

 Set oWindow = _SelectWindow()
 Select Case oWindow.WindowType
  Case acForm, acQuery, acTable
   RunCommand(acCmdRemoveFilterSort)
   ShowAllrecords = True
  Case Else  ' Ignore action
 End Select

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_NotApplicable:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
End Function  ' ShowAllrecords V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS                         ---
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _CheckColumnType(pvFindWhat As Variant, vDataField As Variant) As Boolean
' Return true if both arguments of the same type
' vDataField is a ResultSet column

Dim bFound As Boolean
 bFound = False
 With com.sun.star.sdbc.DataType
  Select Case vDataField.Type
   Case .DATE, .TIME, .TIMESTAMP
    If VarType(pvFindWhat) = vbDate Then bFound = True
   Case .TINYINT, .SMALLINT, .INTEGER, .BIGINT, .FLOAT, .REAL, .DOUBLE, .NUMERIC, .DECIMAL
    If Utils._InList(VarType(pvFindWhat), Utils._AddNumeric()) Then bFound = True
   Case .CHAR, .VARCHAR, .LONGVARCHAR
    If VarType(pvFindWhat) = vbString Then bFound = True
   Case Else
  End Select
 End With

 _CheckColumnType = bFound

End Function  ' _CheckColumnType V0.9.1

REM -----------------------------------------------------------------------------------------------------------------------
Sub _ConvertDataDescriptor( ByRef poSource As Object _
       , ByVal piSourceRDBMS As Integer _
       , ByRef poTarget As Object _
       , ByRef poDatabase As Object _
       , ByVal Optional pbKey As Boolean _
       )
' Convert source column descriptor to target descriptor
' If RDMSs identical, simply move property by property
' Otherwise
'  - Use Type conversion tables (cfr. DataTypes By RDBMS.ods case study)
'  - Select among synonyms the entry with the lowest Precision at least >= source Precision
'  - Derive TypeName and Precision values

Dim vTypesReference() As Variant, vTypes() As Variant, vTypeNames() As Variant
Dim i As Integer, iType As Integer, iTypeAlias As Integer
Dim iNbTypes As Integer, iBestFit As Integer, lFitPrecision As Long, lPrecision As Long

 On Local Error Goto Error_Sub
 If IsMissing(pbKey) Then pbKey = False

 poTarget.Name = poSource.Name
 poTarget.Description = poSource.Description
 If Not pbKey Then
  poTarget.ControlDefault = poSource.ControlDefault
  poTarget.FormatKey = poSource.FormatKey
  poTarget.HelpText = poSource.HelpText
  poTarget.Hidden = poSource.Hidden
 End If
 poTarget.IsCurrency = poSource.IsCurrency
 poTarget.IsNullable = poSource.IsNullable
 poTarget.Scale = poSource.Scale

 If piSourceRDBMS = poDatabase._RDBMS Or poDatabase._RDBMS = DBMS_UNKNOWN Then
  poTarget.Type = poSource.Type
  poTarget.Precision = poSource.Precision
  poTarget.TypeName = poSource.TypeName
  Goto Exit_Sub
 End If

 ' Search DataType compatibility
 With poDatabase
  ' Find source datatype entry in Reference array
  iType = -1
  For i = 0 To UBound(._ColumnTypesReference)
   If ._ColumnTypesReference(i) = poSource.Type Then
    iType = i
    Exit For
   End If
  Next i
  If iType = -1 Then Goto Error_Compatibility
  iTypeAlias = ._ColumnTypesAlias(iType)
  ' Find best choice for the datatype of the target column
  iNbTypes = UBound(._ColumnTypes)
  iBestFit = -1
  lFitPrecision = -2   ' Some POSTGRES datatypes have a precision of -1
  For i = 0 To iNbTypes
   If ._ColumnTypes(i) = iTypeAlias Then ' Minimal fit = correct datatype
    lPrecision = ._ColumnPrecisions(i)
    If iBestFit = -1 _
      Or (iBestFit > -1 And poSource.Precision > 0 And lPrecision >= poSource.Precision And lPrecision < lFitPrecision) _
      Or (iBestFit > -1 And poSource.Precision = 0 And lPrecision > lFitPrecision) Then ' First fit or better fit
     iBestFit = i
     lFitPrecision = lPrecision
    End If
   End If
  Next i
  If iBestFit = -1 Then Goto Error_Compatibility
  poTarget.Type = iTypeAlias
  poTarget.Precision = lFitPrecision
  poTarget.TypeName = ._ColumnTypeNames(iBestFit)
 End With

Exit_Sub:
 Exit Sub
Error_Compatibility:
 TraceError(TRACEFATAL, ERRCOMPATIBILITY, Utils._CalledSub(), 0, 1, poSource.Name)
 Goto Exit_Sub
Error_Sub:
 TraceError(TRACEABORT, Err, "_ConvertDataDescriptor", Erl)
 Goto Exit_Sub
End Sub  ' ConvertDataDescriptor V1.6.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _DatabaseForm(psForm As String, psControl As String)
'Return DatabaseForm element of Form object (based on psForm which is known as a real form name)
'or of SubForm object (based on psControl which is checked for being a subform)

Dim oForm As Object, oControl As Object, sControls() As String, iControlCount As Integer
Dim bFound As Boolean, i As Integer, sName As String

 Set oForm = Application.Forms(psForm)
 If psControl <> "" Then    ' Search subform
  With oForm.DatabaseForm
   iControlCount = .getCount()
   bFound = False
   If iControlCount > 0 Then
    sControls() = .getElementNames()
    sName = UCase(Utils._Trim(psControl))
    For i = 0 To iControlCount - 1
     If UCase(sControls(i)) = sName Then
      bFound = True
      Exit For
     End If
    Next i
   End If
  End With
  If bFound Then sName = sControls(i) Else Goto Trace_NotFound
  Set oControl = oForm.Controls(sName)
  If oControl._SubType <> CTLSUBFORM Then Goto Trace_SubFormNotFound
  Set _DatabaseForm = oControl.Form.DatabaseForm
 Else
  Set _DatabaseForm = oForm.DatabaseForm
 End If

Exit_Function:
 Exit Function
Trace_NotFound:
 TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(psControl, psForm))
 Goto Exit_Function
Trace_SubFormNotFound:
 TraceError(TRACEFATAL, ERRSUBFORMNOTFOUND, Utils._CalledSub(), 0, , Array(psControl, psForm))
 Goto Exit_Function
End Function  ' _DatabaseForm V1.2.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Sub _DispatchCommand(ByVal psCommand As String)
' Execute command given as argument - ".uno:" is presumed already present
Dim oDocument As Object, oDispatcher As Object, oArgs() As new com.sun.star.beans.PropertyValue, sTargetFrameName As String
Dim oResult As Variant
Dim sCommand As String

 Set oDocument = _SelectWindow().Frame
 Set oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
 sTargetFrameName = ""
 oResult = oDispatcher.executeDispatch(oDocument, psCommand, sTargetFrameName, 0, oArgs())

End Sub    ' _DispatchCommand V1.3.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _getUpperShortcut(ByVal psShortcut As String, ByVal psLastComponent As String) As String
' Return "Forms!myForm" from "Forms!myForm!datField" and "datField"

 If Len(psShortcut) > Len(psLastComponent) Then
  _getUpperShortcut = Split(psShortcut, "!" & Utils._Surround(psLastComponent))(0)
 Else
  _getUpperShortcut = psShortcut
 End If

End Function  ' _getUpperShortcut

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _OpenObject(ByVal psObjectType As String _
   , ByVal pvObjectName As Variant _
   , ByVal pvView As Variant _
   , ByVal pvDataMode As Variant _
   ) As Boolean

 If _ErrorHandler() Then On Local Error Goto Error_Function

 _OpenObject = False
 If Not (Utils._CheckArgument(pvObjectName, 1, vbString) _
  And Utils._CheckArgument(pvView, 2, Utils._AddNumeric(), Array(acViewNormal, acViewPreview, acViewDesign)) _
  And Utils._CheckArgument(pvDataMode, 3, Utils._AddNumeric(), Array(acEdit)) _
   ) Then Goto Exit_Function
Dim oDatabase As Object
 Set oDatabase = Application._CurrentDb()
 If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable

Dim sObjects() As String, sObjectName As String, oController As Object, oObject As Object
Dim i As Integer, bFound As Boolean, lComponent As Long, oQuery As Object

 ' Check existence of object and find its exact (case-sensitive) name
 Select Case psObjectType
  Case "Table"
   sObjects = oDatabase.Connection.getTables.ElementNames()
   lComponent = com.sun.star.sdb.application.DatabaseObject.TABLE
  Case "Query"
   sObjects = oDatabase.Connection.getQueries.ElementNames()
   lComponent = com.sun.star.sdb.application.DatabaseObject.QUERY
  Case "Report"
   sObjects = oDatabase.Document.getReportDocuments.ElementNames()
   lComponent = com.sun.star.sdb.application.DatabaseObject.REPORT
 End Select
 bFound = False
 For i = 0 To UBound(sObjects)
  If UCase(pvObjectName) = UCase(sObjects(i)) Then
   sObjectName = sObjects(i)
   bFound = True
   Exit For
  End If
 Next i
 If Not bFound Then Goto Trace_NotFound

 If psObjectType = "Query" Then  ' Processing for action query
  Set oQuery = Application._CurrentDb().QueryDefs(pvObjectName)
  If oQuery.pType <> dbQSelect Then
   _OpenObject = oQuery.Execute()
   GoTo Exit_Function
  End If
 End If
 Set oController = oDatabase.Document.CurrentController
 Set oObject = oController.loadComponent(lComponent, sObjectName, ( pvView = acViewDesign ))
 _OpenObject = True

Exit_Function:
 Set oObject = Nothing
 Set oQuery = Nothing
 Set oController = Nothing
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "OpenObject", Erl)
 GoTo Exit_Function
Trace_Error:
 TraceError(TRACEFATAL, ERROPENOBJECT, Utils._CalledSub(), 0, , Array(_GetLabel(psObjectType), pvObjectName))
 Goto Exit_Function
Error_NotApplicable:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1)
 Goto Exit_Function
Trace_NotFound:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(psObjectType), pvObjectName))
 Goto Exit_Function
End Function  ' _OpenObject V0.8.9

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PromptFormat(ByVal pvList As Variant) As String
' Return user selection in Format dialog

Dim oDialog As Object, iOKCancel As Integer, oControl As Object

 Set oDialog = CreateUnoDialog(Utils._GetDialogLib().dlgFormat)
 oDialog.Title = _GetLabel("DLGFORMAT_TITLE")

 Set oControl = oDialog.Model.getByName("lblFormat")
 oControl.Label = _GetLabel("DLGFORMAT_LBLFORMAT_LABEL")
 oControl.HelpText = _GetLabel("DLGFORMAT_LBLFORMAT_HELP")

 Set oControl = oDialog.Model.getByName("cboFormat")
 oControl.HelpText = _GetLabel("DLGFORMAT_LBLFORMAT_HELP")

 Set oControl = oDialog.Model.getByName("cmdOK")
 oControl.Label = _GetLabel("DLGFORMAT_CMDOK_LABEL")
 oControl.HelpText = _GetLabel("DLGFORMAT_CMDOK_HELP")

 Set oControl = oDialog.Model.getByName("cmdCancel")
 oControl.Label = _GetLabel("DLGFORMAT_CMDCANCEL_LABEL")
 oControl.HelpText = _GetLabel("DLGFORMAT_CMDCANCEL_HELP")

 Set oControl = oDialog.Model.getByName("cboFormat")
 If UBound(pvList) >= 0 Then
  oControl.Text = pvList(0)
  oControl.StringItemList = pvList
 Else
  oControl.Text = ""
  oControl.StringItemList = Array()
 End If

 iOKCancel = oDialog.Execute()
 Select Case iOKCancel
  Case 1     ' OK
    _PromptFormat = oControl.Text
  Case 0     ' Cancel
    _PromptFormat = ""
  Case Else
 End Select
 oDialog.Dispose()

End Function  ' _PromptFormat V0.8.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _SelectWindow(Optional ByVal piWindowType As Integer, Optional ByVal psWindow As String) As Object
' No argument: find active window
' 2 arguments: find corresponding window
' Return a _Window object type describing the found window

Dim oEnum As Object, oDesk As Object, oComp As Object, oFrame As Object, i As Integer
Dim bFound As Boolean, bActive As Boolean, sName As String, iType As Integer, sDocumentType As String
Dim sImplementation As String, vLocation() As Variant
Dim oWindow As _Window
Dim vPersistent As Variant, oForm As Object

 If _ErrorHandler() Then On Local Error Goto Error_Function

 bActive = IsMissing(piWindowType)
 If IsMissing(psWindow) Then psWindow = ""
 Set oWindow.Frame = Nothing
 oWindow.DocumentType = ""
 If bActive Then
  oWindow.WindowType = acDefault
  oWindow._Name = ""
 Else
  oWindow.WindowType = piWindowType
  Select Case piWindowType
   Case acBasicIDE, acDatabaseWindow : oWindow._Name = ""
   Case Else       : oWindow._Name = psWindow
  End Select
 End If
 iType = acDefault
 sDocumentType = ""

 Set oDesk = CreateUnoService("com.sun.star.frame.Desktop")
 Set oEnum = oDesk.Components().createEnumeration
 Do While oEnum.hasMoreElements
  Set oComp = oEnum.nextElement
  If Utils._hasUNOProperty(oComp, "ImplementationName") Then sImplementation = oComp.ImplementationName Else sImplementation = ""
  Select Case sImplementation
   Case "com.sun.star.comp.basic.BasicIDE"
    Set oFrame = oComp.CurrentController.Frame
    iType = acBasicIDE
    sName = ""
   Case "com.sun.star.comp.dba.ODatabaseDocument"
    Set oFrame = oComp.CurrentController.Frame
    iType = acDatabaseWindow
    sName = ""
   Case "SwXTextDocument"
    If HasUnoInterfaces(oComp, "com.sun.star.frame.XModule") Then
     Select Case oComp.Identifier
      Case "com.sun.star.sdb.FormDesign"   ' Form
       iType = acForm
      Case "com.sun.star.sdb.TextReportDesign" ' Report
       iType = acReport
      Case "com.sun.star.text.TextDocument"  ' Writer
       vLocation = Split(oComp.getLocation(), "/")
       If UBound(vLocation) >= 0 Then sName = Join(Split(vLocation(UBound(vLocation)), "%20"), " ") Else sName = ""
       iType = acDocument
       sDocumentType = docWriter
     End Select
     If iType = acForm Then    ' Identify persistent Form name
      vPersistent = Split(oComp.StringValue, "/")
      sName = _GetHierarchicalName(vPersistent(UBound(vPersistent) - 1))
     ElseIf iType = acReport Then  ' Identify Report name
      For i = 0 To UBound(oComp.Args())
       If oComp.Args(i).Name = "DocumentTitle" Then
        sName = oComp.Args(i).Value
        Exit For
       End If
      Next i
     End If
     Set oFrame = oComp.CurrentController.Frame
    End If
   Case "org.openoffice.comp.dbu.ODatasourceBrowser"
    Set oFrame = oComp.Frame
    If Not IsEmpty(oComp.Selection) Then  ' Empty for (F4) DatasourceBrowser !!
     For i = 0 To UBound(oComp.Selection())
      If oComp.Selection(i).Name = "Command" Then
       sName = oComp.Selection(i).Value
      ElseIf oComp.Selection(i).Name = "CommandType" Then
       Select Case oComp.selection(i).Value
        Case com.sun.star.sdb.CommandType.TABLE
         iType = acTable
        Case com.sun.star.sdb.CommandType.QUERY
         iType = acQuery
        Case com.sun.star.sdb.CommandType.COMMAND
         iType = acQuery  ' SQL for future use ?
       End Select
      End If
     Next i
   ' Else ignore
    End If
   Case "org.openoffice.comp.dbu.OTableDesign", "org.openoffice.comp.dbu.OQueryDesign"   ' Table or Query in Edit mode
    If Not bActive Then
     If UCase(Right(oComp.Title, Len(psWindow))) = UCase(psWindow) Then ' No rigorous mean found to identify Name
      Set oFrame = oComp.Frame
      Select Case sImplementation
       Case "org.openoffice.comp.dbu.OTableDesign" : iType = acTable
       Case "org.openoffice.comp.dbu.OQueryDesign" : iType = acQuery
      End Select
      sName = Right(oComp.Title, Len(psWindow))
     End If
    Else
     Set oFrame = Nothing
    End If
   Case "org.openoffice.comp.dbu.ORelationDesign"
    Set oFrame = oComp.Frame
    iType = acDiagram
    sName = ""
   Case "com.sun.star.comp.sfx2.BackingComp"    '  Welcome screen
    Set oFrame = oComp.Frame
    iType = acWelcome
    sName = ""
   Case Else  ' Other Calc, ..., whatever documents
    If Utils._hasUNOProperty(oComp, "Location") Then
     vLocation = Split(oComp.getLocation(), "/")
     If UBound(vLocation) >= 0 Then sName = Join(Split(vLocation(UBound(vLocation)), "%20"), " ") Else sName = ""
     iType = acDocument
     If Utils._hasUNOProperty(oComp, "Identifier") Then
      Select Case oComp.Identifier
       Case "com.sun.star.sheet.SpreadsheetDocument"   : sDocumentType = docCalc
       Case "com.sun.star.presentation.PresentationDocument" : sDocumentType = docImpress
       Case "com.sun.star.drawing.DrawingDocument"    : sDocumentType = docDraw
       Case "com.sun.star.formula.FormulaProperties"   : sDocumentType = docMath
       Case Else            : sDocumentType = ""
      End Select
     End If
     Set oFrame = oComp.CurrentController.Frame
    End If
  End Select
  If bActive And Not IsNull(oFrame) Then
   If oFrame.ContainerWindow.IsActive() Then
    bFound = True
    Exit Do
   End If
  ElseIf iType = piWindowType And UCase(sName) = UCase(psWindow) Then
   bFound = True
   Exit Do
  End If
 Loop

 If bFound Then
  Set oWindow.Frame = oFrame
  oWindow._Name = sName
  oWindow.WindowType = iType
  oWindow.DocumentType = sDocumentType
 Else
  Set oWindow.Frame = Nothing
 End If

Exit_Function:
 Set _SelectWindow = oWindow
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "SelectWindow", Erl)
 GoTo Exit_Function
End Function  ' _SelectWindow V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _SendWithAttachment( _
   ByVal pvRecipients() As Variant _
   , ByVal pvCcRecipients() As Variant _
   , ByVal pvBccRecipients() As Variant _
   , ByVal psSubject As String _
   , ByVal pvAttachments() As Variant _
   , ByVal pvBody As String _
   , ByVal pbEditMessage As Boolean _
   ) As Boolean

' Send message with attachments
 If _ErrorHandler() Then On Local Error Goto Error_Function
 _SendWithAttachment = False

Const cstWindows = 1
Const cstLinux = 4
Const cstSemiColon = ";"
Dim oServiceMail as Object, oMail As Object, oMessage As Object, vFlag As Variant
Dim vCc() As Variant, i As Integer, iOS As Integer, sProduct As String, bMailProvider As Boolean

 'OPENOFFICE <= 3.6 and LIBREOFFICE have XSimple...Mail interface while OPENOFFICE >= 4.0 has XSystemMailProvider interface
 sProduct = UCase(Utils._GetProductName())
 bMailProvider = ( Left(sProduct, 4) = "OPEN" And Left(_GetProductName("VERSION"), 3) >= "4.0" )

 iOS = GetGuiType()
 Select Case iOS
  Case cstLinux
   oServiceMail = createUnoService("com.sun.star.system.SimpleCommandMail")
  Case cstWindows
   If bMailProvider Then oServiceMail = createUnoService("com.sun.star.system.SystemMailProvider") _
        Else oServiceMail = createUnoService("com.sun.star.system.SimpleSystemMail")
  Case Else
   Goto Error_Mail
 End Select

 If bMailProvider Then Set oMail = oServiceMail.queryMailClient() _
      Else Set oMail = oServiceMail.querySimpleMailClient()
 If IsNull(oMail) Then Goto Error_Mail

 'Reattribute Recipients >= 2nd to ccRecipients
 If UBound(pvRecipients) <= 0 Then
  If UBound(pvCcRecipients) >= 0 Then vCc = pvCcRecipients
 Else
  ReDim vCc(0 To UBound(pvRecipients) - 1 + UBound(pvCcRecipients) + 1)
  For i = 0 To UBound(pvRecipients) - 1
   vCc(i) = pvRecipients(i + 1)
  Next i
  For i = UBound(pvRecipients) To UBound(vCc)
   vCc(i) = pvCcRecipients(i - UBound(pvRecipients))
  Next i
 End If

 If bMailProvider Then
  Set oMessage = oMail.createMailMessage()
  If UBound(pvRecipients) >= 0 Then oMessage.Recipient = pvRecipients(0)
  If psSubject <> "" Then oMessage.Subject = psSubject
  Select Case iOS  ' Not published differences between com.sun.star.system.SimpleCommandMail and SimpleSystemMail
   Case cstLinux
    If UBound(vCc) >= 0 Then oMessage.CcRecipient = Array(Join(vCc, cstSemiColon))
    If UBound(pvBccRecipients) >= 0 Then oMessage.BccRecipient = Array(Join(pvBccRecipients, cstSemiColon))
   Case cstWindows
    If UBound(vCc) >= 0 Then oMessage.CcRecipient = vCc
    If UBound(pvBccRecipients) >= 0 Then oMessage.BccRecipient = pvBccRecipients
  End Select
  If UBound(pvAttachments) >= 0 Then oMessage.Attachement = pvAttachments
  If pvBody <> "" Then oMessage.Body = pvBody
  If pbEditMessage Then
   vFlag = com.sun.star.system.MailClientFlags.DEFAULTS
  Else
   vFlag = com.sun.star.system.MailClientFlags.NO_USER_INTERFACE
  End If
  oMail.sendMailMessage(oMessage, vFlag)
 Else
  Set oMessage = oMail.createSimpleMailMessage()  ' Body NOT SUPPORTED !
  If UBound(pvRecipients) >= 0 Then oMessage.setRecipient(pvRecipients(0))
  If psSubject <> "" Then oMessage.setSubject(psSubject)
  Select Case iOS
   Case cstLinux
    If UBound(vCc) >= 0 Then oMessage.setCcRecipient(Array(Join(vCc, cstSemiColon)))
    If UBound(pvBccRecipients) >= 0 Then oMessage.setBccRecipient(Array(Join(pvBccRecipients, cstSemiColon)))
   Case cstWindows
    If UBound(vCc) >= 0 Then oMessage.setCcRecipient(vCc)
    If UBound(pvBccRecipients) >= 0 Then oMessage.setBccRecipient(pvBccRecipients)
  End Select
  If UBound(pvAttachments) >= 0 Then oMessage.setAttachement(pvAttachments)
  If pbEditMessage Then
   vFlag = com.sun.star.system.SimpleMailClientFlags.DEFAULTS
  Else
   vFlag = com.sun.star.system.SimpleMailClientFlags.NO_USER_INTERFACE
  End If
  oMail.sendSimpleMailMessage(oMessage, vFlag)
 End If

 _SendWithAttachment = True

Exit_Function:
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "_SendWithAttachment", Erl)
 Goto Exit_Function
Error_Mail:
 TraceError(TRACEFATAL, ERRSENDMAIL, Utils._CalledSub(), 0)
 Goto Exit_Function
End Function  ' _SendWithAttachment V0.9.5

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _SendWithoutAttachment(ByVal pvTo As Variant _
      , ByVal pvCc As Variant _
      , ByVal pvBcc As Variant _
      , ByVal psSubject As String _
      , ByVal psBody As String _
      ) As Boolean
'Send simple message with mailto: syntax
Dim sMailTo As String, sTo As String, sCc As String, sBcc As String, oDispatch As Object
Const cstComma = ","

 If _ErrorHandler() Then On Local Error Goto Error_Function

 If UBound(pvTo) >= 0 Then sTo = Trim(Join(pvTo, cstComma)) Else sTo = ""
 If UBound(pvCc) >= 0 Then sCc = Trim(Join(pvCc, cstComma)) Else sCc = ""
 If UBound(pvBcc) >= 0 Then sBcc = Trim(Join(pvBcc, cstComma)) Else sBcc = ""

 sMailTo = "mailto:" _
    & sTo & "?" _
    & Iif(sCc = "", "", "cc=" & sCc & "&") _
    & Iif(sBcc = "", "", "bcc=" & sBcc & "&") _
    & Iif(psSubject = "", "", "subject=" & psSubject & "&") _
    & Iif(psBody = "", "", "body=" & psBody & "&")
 If Right(sMailTo, 1) = "&" Or Right(sMailTo, 1) = "?" Then sMailTo = Left(sMailTo, Len(sMailTo) - 1)
 sMailTo = ConvertToUrl(sMailTo)

 oDispatch = createUnoService( "com.sun.star.frame.DispatchHelper")
 oDispatch.executeDispatch(StarDesktop, sMailTo, "", 0, Array())

 _SendWithoutAttachment = True

Exit_Function:
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "_SendWithoutAttachments", Erl)
 _SendWithoutAttachment = False
 Goto Exit_Function
End Function  ' _SendWithoutAttachment V0.8.5

REM -----------------------------------------------------------------------------------------------------------------------
Private Sub _ShellExecute(sCommand As String)
' Execute shell command

Dim oShell As Object
 Set oShell = createUnoService("com.sun.star.system.SystemShellExecute")
 oShell.execute(sCommand, "" , com.sun.star.system.SystemShellExecuteFlags.URIS_ONLY)

End Sub    ' _ShellExecute   V0.8.5

</script:module>

[0.77QuellennavigatorsProjekt 2026-05-07]

                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Software

     Produkte
     Quellcodebibliothek

Aktivitäten

     Artikel über Sicherheit
     Anleitung zur Aktivierung von SSL

Muße

     Gedichte
     Musik
     Bilder

Jenseits des Üblichen ....
    

Besucherstatistik

Besucherstatistik

Monitoring

Montastic status badge