Quelle  DoCmd.xba   Sprache: unbekannt

<?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"
--> --------------------

--> maximum size reached

--> --------------------