DoCmd.xba 116 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="DoCmd" script:language="StarBasic">
  4. REM =======================================================================================================================
  5. REM === The Access2Base library is a part of the LibreOffice project. ===
  6. REM === Full documentation is available on http://www.access2base.com ===
  7. REM =======================================================================================================================
  8. Option Explicit
  9. Type _FindParams
  10. FindRecord As Integer &apos; Set to 1 at first invocation of FindRecord
  11. FindWhat As Variant
  12. Match As Integer
  13. MatchCase As Boolean
  14. Search As Integer
  15. SearchAsFormatted As Boolean &apos; Must be False
  16. FindFirst As Boolean
  17. OnlyCurrentField As Integer
  18. Form As String &apos; Shortcut
  19. GridControl As String &apos; Shortcut
  20. Target As String &apos; Shortcut
  21. LastRow As Long &apos; Last row explored - 0 = before first
  22. LastColumn As Integer &apos; Last column explored - 0 ... N-1 index in next arrays; 0 if OnlyCurrentField = acCurrent
  23. ColumnNames() As String &apos; Array of column names in grid with boundfield and of same type as FindWhat
  24. ResultSetIndex() As Integer &apos; Array of column numbers in ResultSet
  25. End Type
  26. Type _Window
  27. Frame As Object &apos; com.sun.star.comp.framework.Frame
  28. _Name As String &apos; Object Name
  29. WindowType As Integer &apos; One of the object types
  30. DocumentType As String &apos; Writer, Calc, ... - Only if WindowType = acDocument
  31. End Type
  32. REM VBA allows call to actions with missing arguments e.g. OpenForm(&quot;aaa&quot;,,&quot;[field]=2&quot;)
  33. REM in StarBasic IsMissing requires Variant parameters
  34. REM -----------------------------------------------------------------------------------------------------------------------
  35. Public Function ApplyFilter( _
  36. ByVal Optional pvFilter As Variant _
  37. , ByVal Optional pvSQL As Variant _
  38. , ByVal Optional pvControlName As Variant _
  39. ) As Boolean
  40. &apos; Set filter on open table, query, form or subform (if pvControlName present)
  41. If _ErrorHandler() Then On Local Error Goto Error_Function
  42. Const cstThisSub = &quot;ApplyFilter&quot;
  43. Utils._SetCalledSub(cstThisSub)
  44. ApplyFilter = False
  45. If IsMissing(pvFilter) And IsMissing(pvSQL) Then Call _TraceArguments()
  46. If IsMissing(pvFilter) Then pvFilter = &quot;&quot;
  47. If Not Utils._CheckArgument(pvFilter, 1, vbString) Then Goto Exit_Function
  48. If IsMissing(pvSQL) Then pvSQL = &quot;&quot;
  49. If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function
  50. If IsMissing(pvControlName) Then pvControlName = &quot;&quot;
  51. If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function
  52. Dim sFilter As String, oWindow As Object, oDatabase As Object, oTarget As Object
  53. Set oDatabase = Application._CurrentDb()
  54. If oDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
  55. If pvSQL &lt;&gt; &quot;&quot; _
  56. Then sFilter = oDatabase._ReplaceSquareBrackets(pvSQL) _
  57. Else sFilter = oDatabase._ReplaceSquareBrackets(pvFilter)
  58. Set oWindow = _SelectWindow()
  59. With oWindow
  60. Select Case .WindowType
  61. Case acForm
  62. Set oTarget = _DatabaseForm(._Name, pvControlName)
  63. Case acQuery, acTable
  64. If pvControlName &lt;&gt; &quot;&quot; Then Goto Exit_Function
  65. If IsNull(.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
  66. &apos; FormOperations returns &lt;Null&gt; in OpenOffice
  67. Set oTarget = .Frame.Controller.FormOperations.Cursor
  68. Case Else &apos; Ignore action
  69. Goto Exit_Function
  70. End Select
  71. End With
  72. With oTarget
  73. .Filter = sFilter
  74. .ApplyFilter = True
  75. .reload()
  76. End With
  77. ApplyFilter = True
  78. Exit_Function:
  79. Utils._ResetCalledSub(cstThisSub)
  80. Exit Function
  81. Error_NotApplicable:
  82. TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
  83. Goto Exit_Function
  84. Error_Function:
  85. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  86. GoTo Exit_Function
  87. End Function &apos; ApplyFilter V1.2.0
  88. REM -----------------------------------------------------------------------------------------------------------------------
  89. Public Function mClose(Optional ByVal pvObjectType As Variant _
  90. , Optional ByVal pvObjectName As Variant _
  91. , Optional ByVal pvSave As Variant _
  92. ) As Boolean
  93. If _ErrorHandler() Then On Local Error Goto Error_Function
  94. Const cstThisSub = &quot;Close&quot;
  95. Utils._SetCalledSub(cstThisSub)
  96. mClose = False
  97. If IsMissing(pvObjectType) Or IsMissing(pvObjectName) Then Call _TraceArguments()
  98. If IsMissing(pvSave) Then pvSave = acSavePrompt
  99. If Not (Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _
  100. Array(acTable, acQuery, acForm, acReport)) _
  101. And Utils._CheckArgument(pvObjectName, 2, vbString) _
  102. And Utils._CheckArgument(pvSave, 3, Utils._AddNumeric(), Array(acSavePrompt)) _
  103. ) Then Goto Exit_Function
  104. Dim sObjects() As String, sObjectName As String, oController As Object, oObject As Object
  105. Dim i As Integer, bFound As Boolean, lComponent As Long
  106. Dim oDatabase As Object
  107. Set oDatabase = Application._CurrentDb()
  108. If oDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
  109. &apos; Check existence of object and find its exact (case-sensitive) name
  110. Select Case pvObjectType
  111. Case acForm
  112. sObjects = Application._GetAllHierarchicalNames()
  113. lComponent = com.sun.star.sdb.application.DatabaseObject.FORM
  114. Case acTable
  115. sObjects = oDatabase.Connection.getTables.ElementNames()
  116. lComponent = com.sun.star.sdb.application.DatabaseObject.TABLE
  117. Case acQuery
  118. sObjects = oDatabase.Connection.getQueries.ElementNames()
  119. lComponent = com.sun.star.sdb.application.DatabaseObject.QUERY
  120. Case acReport
  121. sObjects = oDatabase.Document.getReportDocuments.ElementNames()
  122. lComponent = com.sun.star.sdb.application.DatabaseObject.REPORT
  123. End Select
  124. bFound = False
  125. For i = 0 To UBound(sObjects)
  126. If UCase(pvObjectName) = UCase(sObjects(i)) Then
  127. sObjectName = sObjects(i)
  128. bFound = True
  129. Exit For
  130. End If
  131. Next i
  132. If Not bFound Then Goto Trace_NotFound
  133. Select Case pvObjectType
  134. Case acForm
  135. Set oController = oDatabase.Document.getFormDocuments.getByHierarchicalName(sObjectName)
  136. mClose = oController.close()
  137. Case acTable, acQuery &apos; Not optimal but it works !!
  138. Set oController = oDatabase.Document.CurrentController
  139. Set oObject = oController.loadComponent(lComponent, sObjectName, False)
  140. oObject.frame.close(False)
  141. mClose = True
  142. Case acReport
  143. Set oController = oDatabase.Document.getReportDocuments.getByName(sObjectName)
  144. mClose = oController.close()
  145. End Select
  146. Exit_Function:
  147. Set oObject = Nothing
  148. Set oController = Nothing
  149. Utils._ResetCalledSub(cstThisSub)
  150. Exit Function
  151. Error_Function:
  152. TraceError(TRACEABORT, Err, &quot;Close&quot;, Erl)
  153. GoTo Exit_Function
  154. Trace_Error:
  155. TraceError(TRACEFATAL, ERRCLOSEOBJECT, Utils._CalledSub(), 0, , Array(_GetLabel(Array(&quot;Table&quot;, &quot;Query&quot;, &quot;Form&quot;, &quot;Report&quot;)(pvObjectType)), pvObjectName))
  156. Goto Exit_Function
  157. Trace_NotFound:
  158. TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(Array(&quot;Table&quot;, &quot;Query&quot;, &quot;Form&quot;, &quot;Report&quot;)(pvObjectType)), pvObjectName))
  159. Goto Exit_Function
  160. Error_NotApplicable:
  161. TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
  162. Goto Exit_Function
  163. End Function &apos; (m)Close V1.1.0
  164. REM -----------------------------------------------------------------------------------------------------------------------
  165. Public Function CopyObject(ByVal Optional pvSourceDatabase As Variant _
  166. , ByVal Optional pvNewName As Variant _
  167. , ByVal Optional pvSourceType As Variant _
  168. , ByVal Optional pvSourceName As Variant _
  169. ) As Boolean
  170. &apos; Copies tables and queries into identical (new) objects
  171. If _ErrorHandler() Then On Local Error Goto Error_Function
  172. Const cstThisSub = &quot;CopyObject&quot;
  173. Utils._SetCalledSub(cstThisSub)
  174. CopyObject = False
  175. If IsMissing(pvSourceDatabase) Then pvSourceDatabase = &quot;&quot;
  176. If VarType(pvSourceDatabase) &lt;&gt; vbString Then
  177. If Not Utils._CheckArgument(pvSourceDatabase, 1, OBJDATABASE) Then Goto Exit_Function
  178. End If
  179. If IsMissing(pvNewName) Then Call _TraceArguments()
  180. If Not Utils._CheckArgument(pvNewName, 2, vbString) Then Goto Exit_Function
  181. If IsMissing(pvSourceType) Then Call _TraceArguments()
  182. If Not Utils._CheckArgument(pvSourceType, 1, Utils._AddNumeric(), Array(acQuery, acTable) _
  183. ) Then Goto Exit_Function
  184. If IsMissing(pvSourceName) Then Call _TraceArguments()
  185. If Not Utils._CheckArgument(pvSourceName, 2, vbString) Then Goto Exit_Function
  186. Dim oSource As Object, oSourceDatabase As Object, oTarget As Object, oDatabase As Object, bSameDatabase As Boolean
  187. Dim oSourceTable As Object, oSourceColumns As Object, oSourceCol As Object, oTargetCol As Object, iRDBMS As Integer
  188. Dim oSourceKeys As Object, oSourceKey As Object, oTargetKey As Object
  189. Dim i As Integer, j As Integer, sSql As String, vPrimaryKeys() As Variant
  190. Dim vNameComponents() As Variant, iNames As Integer, sSurround As String
  191. Dim vInputField As Variant, vFieldBinary() As Variant, vOutputField As Variant
  192. Dim oInput as Object, oOutput As Object, iNbFields As Integer, vValue As Variant
  193. Dim vBinary As Variant, lInputSize As Long, lOutputSize As Long
  194. Dim lInputRecs As Long, lInputMax As Long, vField As Variant, bProgressMeter As Boolean, sFile As String
  195. Const cstMaxBinlength = 2 * 65535
  196. Const cstChunkSize = 2 * 65535
  197. Const cstProgressMeterLimit = 100
  198. Set oDatabase = Application._CurrentDb()
  199. bSameDatabase = False
  200. If VarType(pvSourceDatabase) = vbString Then
  201. If pvSourceDatabase = &quot;&quot; Then
  202. Set oSourceDatabase = oDatabase
  203. bSameDatabase = True
  204. Else
  205. Set oSourceDatabase = Application.OpenDatabase(ConvertToUrl(pvSourceDatabase), &quot;&quot;, &quot;&quot;, True)
  206. If IsNull(oSourceDatabase) Then Goto Exit_Function
  207. End If
  208. Else
  209. Set oSourceDatabase = pvSourceDatabase
  210. End If
  211. With oDatabase
  212. iRDBMS = ._RDBMS
  213. If ._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
  214. Select Case pvSourceType
  215. Case acQuery
  216. Set oSource = oSourceDatabase.QueryDefs(pvSourceName, True)
  217. If IsNull(oSource) Then Goto Error_NotFound
  218. Set oTarget = .QueryDefs(pvNewName, True)
  219. If Not IsNull(oTarget) Then .Connection.getQueries.dropByName(oTarget.Name) &apos; a query with same name exists already ... drop it
  220. If oSource.Query.EscapeProcessing Then
  221. Set oTarget = .CreateQueryDef(pvNewName, oSource.SQL)
  222. Else
  223. Set oTarget = .CreateQueryDef(pvNewName, oSource.SQL, dbSQLPassThrough)
  224. End If
  225. &apos; Save .odb document
  226. .Document.store()
  227. Case acTable
  228. Set oSource = oSourceDatabase.TableDefs(pvSourceName, True)
  229. If IsNull(oSource) Then Goto Error_NotFound
  230. Set oTarget = .TableDefs(pvNewName, True)
  231. &apos; A table with same name exists already ... drop it
  232. If Not IsNull(oTarget) Then .Connection.getTables.dropByName(oTarget.Name)
  233. &apos; Copy source table columns
  234. Set oSourceTable = oSource.Table
  235. Set oTarget = .Connection.getTables.createDataDescriptor
  236. oTarget.Description = oSourceTable.Description
  237. vNameComponents = Split(pvNewName, &quot;.&quot;)
  238. iNames = UBound(vNameComponents)
  239. If iNames &gt;= 2 Then oTarget.CatalogName = vNameComponents(iNames - 2) Else oTarget.CatalogName = &quot;&quot;
  240. If iNames &gt;= 1 Then oTarget.SchemaName = vNameComponents(iNames - 1) Else oTarget.SchemaName = &quot;&quot;
  241. oTarget.Name = vNameComponents(iNames)
  242. oTarget.Type = oSourceTable.Type
  243. Set oSourceColumns = oSourceTable.Columns
  244. Set oTargetCol = oTarget.Columns.createDataDescriptor
  245. For i = 0 To oSourceColumns.getCount() - 1
  246. &apos; Append each individual column to the table descriptor
  247. Set oSourceCol = oSourceColumns.getByIndex(i)
  248. _ConvertDataDescriptor oSourceCol, oSourceDatabase._RDBMS, oTargetCol, oDatabase
  249. oTarget.Columns.appendByDescriptor(oTargetCol)
  250. Next i
  251. &apos; Copy keys
  252. Set oSourceKeys = oSourceTable.Keys
  253. Set oTargetKey = oTarget.Keys.createDataDescriptor()
  254. For i = 0 To oSourceKeys.getCount() - 1
  255. &apos; Append each key to table descriptor
  256. Set oSourceKey = oSourceKeys.getByIndex(i)
  257. oTargetKey.DeleteRule = oSourceKey.DeleteRule
  258. oTargetKey.Name = oSourceKey.Name
  259. oTargetKey.ReferencedTable = oSourceKey.ReferencedTable
  260. oTargetKey.Type = oSourceKey.Type
  261. oTargetKey.UpdateRule = oSourceKey.UpdateRule
  262. Set oTargetCol = oTargetKey.Columns.createDataDescriptor()
  263. For j = 0 To oSourceKey.Columns.getCount() - 1
  264. Set oSourceCol = oSourceKey.Columns.getByIndex(j)
  265. _ConvertDataDescriptor oSourceCol, oSourceDatabase._RDBMS, oTargetCol, oDatabase, True
  266. oTargetKey.Columns.appendByDescriptor(oTargetCol)
  267. Next j
  268. oTarget.Keys.appendByDescriptor(oTargetKey)
  269. Next i
  270. &apos; Duplicate table whole design
  271. .Connection.getTables.appendByDescriptor(oTarget)
  272. &apos; Copy data
  273. Select Case bSameDatabase
  274. Case True
  275. &apos; Build SQL statement to copy data
  276. sSurround = Utils._Surround(oSource.Name)
  277. sSql = &quot;INSERT INTO &quot; &amp; Utils._Surround(pvNewName) &amp; &quot; SELECT &quot; &amp; sSurround &amp; &quot;.* FROM &quot; &amp; sSurround
  278. DoCmd.RunSQL(sSql)
  279. Case False
  280. &apos; Copy data row by row and field by field
  281. &apos; As it is slow ... display a progress meter
  282. Set oInput = oSourceDatabase.OpenRecordset(oSource.Name, , , dbReadOnly)
  283. Set oOutput = .Openrecordset(pvNewName)
  284. With oInput
  285. If Not ( ._BOF And ._EOF ) Then
  286. .MoveLast
  287. lInputMax = .RecordCount
  288. lInputRecs = 0
  289. .MoveFirst
  290. bProgressMeter = ( lInputMax &gt; cstProgressMeterLimit )
  291. iNbFields = .Fields().Count - 1
  292. vFieldBinary = Array()
  293. ReDim vFieldBinary(0 To iNbFields)
  294. For i = 0 To iNbFields
  295. vFieldBinary(i) = Utils._IsBinaryType(.Fields(i).Column.Type)
  296. Next i
  297. Else
  298. bProgressMeter = False
  299. End If
  300. If bProgressMeter Then Application.SysCmd acSysCmdInitMeter, pvNewName &amp; &quot; 0 %&quot;, lInputMax
  301. Do While Not .EOF()
  302. oOutput.RowSet.moveToInsertRow()
  303. oOutput._EditMode = dbEditAdd
  304. For i = 0 To iNbFields
  305. Set vInputField = .Fields(i)
  306. Set vOutputField = oOutput.Fields(i)
  307. If vFieldBinary(i) Then
  308. lInputSize = vInputField.FieldSize
  309. If lInputSize &lt;= cstMaxBinlength Then
  310. vField = Utils._getResultSetColumnValue(.RowSet, i + 1, True)
  311. Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField)
  312. ElseIf oDatabase._BinaryStream Then
  313. &apos; Typically for SQLite where binary fields are limited
  314. If lInputSize &gt; vOutputField._Precision Then
  315. TraceError(TRACEWARNING, ERRPRECISION, Utils._CalledSub(), 0, 1, Array(vOutputField._Name, lInputRecs + 1))
  316. Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, Null)
  317. Else
  318. sFile = Utils._GetRandomFileName(&quot;BINARY&quot;)
  319. vInputField._WriteAll(sFile, &quot;WriteAllBytes&quot;)
  320. vOutputField._ReadAll(sFile, &quot;ReadAllBytes&quot;)
  321. Kill ConvertToUrl(sFile)
  322. End If
  323. End If
  324. Else
  325. vField = Utils._getResultSetColumnValue(.RowSet, i + 1)
  326. If VarType(vField) = vbString Then
  327. If Len(vField) &gt; vOutputField._Precision Then
  328. TraceError(TRACEWARNING, ERRPRECISION, Utils._CalledSub(), 0, 1, Array(vOutputField._Name, lInputRecs + 1))
  329. End If
  330. End If
  331. &apos; Update is done anyway, if too long, with truncation
  332. Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField)
  333. End If
  334. Next i
  335. If oOutput.RowSet.IsNew And oOutput.RowSet.IsModified Then oOutput.RowSet.insertRow()
  336. oOutput._EditMode = dbEditNone
  337. lInputRecs = lInputRecs + 1
  338. If bProgressMeter Then
  339. If lInputRecs Mod (lInputMax / 100) = 0 Then
  340. Application.SysCmd acSysCmdUpdateMeter, pvNewName &amp; &quot; &quot; &amp; CStr(CLng(lInputRecs * 100 / lInputMax)) &amp; &quot;%&quot;, lInputRecs
  341. End If
  342. End If
  343. .MoveNext
  344. Loop
  345. End With
  346. oOutput.mClose()
  347. Set oOutput = Nothing
  348. oInput.mClose()
  349. Set oInput = Nothing
  350. if bProgressMeter Then Application.SysCmd acSysCmdClearStatus
  351. End Select
  352. Case Else
  353. End Select
  354. End With
  355. CopyObject = True
  356. Exit_Function:
  357. &apos; Avoid closing the current database or the database object given as source argument
  358. If VarType(pvSourceDatabase) = vbString And Not bSameDatabase Then
  359. If Not IsNull(oSourceDatabase) Then oSourceDatabase.mClose()
  360. End If
  361. Set oSourceDatabase = Nothing
  362. If Not IsNull(oOutput) Then oOutput.mClose()
  363. Set oOutput = Nothing
  364. If Not IsNull(oInput) Then oInput.mClose()
  365. Set oInput = Nothing
  366. Set oSourceCol = Nothing
  367. Set oSourceKey = Nothing
  368. Set oSourceKeys = Nothing
  369. Set oSource = Nothing
  370. Set oSourceTable = Nothing
  371. Set oSourceColumns = Nothing
  372. Set oTargetCol = Nothing
  373. Set oTargetKey = Nothing
  374. Set oTarget = Nothing
  375. Utils._ResetCalledSub(cstThisSub)
  376. Exit Function
  377. Error_NotFound:
  378. TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(Iif(pvSourceType = acQuery, _GetLabel(&quot;QUERY&quot;), _GetLabel(&quot;TABLE&quot;)), pvSourceName))
  379. Goto Exit_Function
  380. Error_NotApplicable:
  381. TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
  382. Goto Exit_Function
  383. Error_Function:
  384. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  385. GoTo Exit_Function
  386. End Function &apos; CopyObject V1.1.0
  387. REM -----------------------------------------------------------------------------------------------------------------------
  388. Public Function FindNext() As Boolean
  389. &apos; Must be called after a FindRecord
  390. &apos; Execute instructions set in FindRecord object
  391. If _ErrorHandler() Then On Local Error Goto Error_Function
  392. FindNext = False
  393. Utils._SetCalledSub(&quot;FindNext&quot;)
  394. Dim ofForm As Object, ocGrid As Object
  395. Dim i As Integer, lInitialRow As Long, lFindRow As Long
  396. Dim bFound As Boolean, b2ndRound As Boolean, bStop As Boolean
  397. Dim vFindValue As Variant, oFindrecord As Object
  398. Set oFindRecord = _A2B_.FindRecord
  399. If IsNull(oFindRecord) Then GoTo Error_FindRecord
  400. With oFindRecord
  401. If .FindRecord = 0 Then Goto Error_FindRecord
  402. .FindRecord = 0
  403. Set ofForm = getObject(.Form)
  404. If ofForm._Type = OBJCONTROL Then Set ofForm = ofForm.Form &apos; Bug Tombola
  405. Set ocGrid = getObject(.GridControl)
  406. &apos; Move cursor to the initial row. Operation based on last FindRecord, not on user interactions done inbetween
  407. If ofForm.DatabaseForm.RowCount &lt;= 0 then Goto Exit_Function &apos; Dataset is empty
  408. lInitialRow = .LastRow &apos; Used if Search = acSearchAll
  409. bFound = False
  410. lFindRow = .LastRow
  411. b2ndRound = False
  412. Do
  413. &apos; Last column ? Go to next row
  414. If .LastColumn &gt;= UBound(.ColumnNames) Then
  415. bStop = False
  416. If ofForm.DatabaseForm.isAfterLast() And .Search = acUp Then
  417. ofForm.DatabaseForm.last()
  418. ElseIf ofForm.DatabaseForm.isLast() And .Search = acSearchAll Then
  419. ofForm.DatabaseForm.first()
  420. b2ndRound = True
  421. ElseIf ofForm.DatabaseForm.isBeforeFirst() And (.Search = acDown Or .Search = acSearchAll) Then
  422. ofForm.DatabaseForm.first()
  423. ElseIf ofForm.DatabaseForm.isFirst() And .search = acUp Then
  424. ofForm.DatabaseForm.beforeFirst()
  425. bStop = True
  426. ElseIf ofForm.DatabaseForm.isLast() And .search = acDown Then
  427. ofForm.DatabaseForm.afterLast()
  428. bStop = True
  429. ElseIf .Search = acUp Then
  430. ofForm.DatabaseForm.previous()
  431. Else
  432. ofForm.DatabaseForm.next()
  433. End If
  434. lFindRow = ofForm.DatabaseForm.getRow()
  435. If bStop Or (.Search = acSearchAll And lFindRow &gt;= lInitialRow And b2ndRound) Then
  436. ofForm.DatabaseForm.absolute(lInitialRow)
  437. Exit Do
  438. End If
  439. .LastColumn = 0
  440. Else
  441. .LastColumn = .LastColumn + 1
  442. End If
  443. &apos; Examine column contents
  444. If .LastColumn &lt;= UBound(.ColumnNames) Then
  445. For i = .LastColumn To UBound(.ColumnNames)
  446. vFindValue = Utils._getResultSetColumnValue(ofForm.DatabaseForm.createResultSet(), .ResultSetIndex(i))
  447. Select Case VarType(.FindWhat)
  448. Case vbDate, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
  449. bFound = ( .FindWhat = vFindValue )
  450. Case vbString
  451. If VarType(vFindValue) = vbString Then
  452. Select Case .Match
  453. Case acStart
  454. If .MatchCase Then
  455. bFound = ( Left(.FindWhat, Len(.FindWhat)) = vFindValue )
  456. Else
  457. bFound = ( UCase(Left(.FindWhat, Len(.FindWhat))) = UCase(vFindValue) )
  458. End If
  459. Case acAnyWhere
  460. If .MatchCase Then
  461. bFound = ( InStr(1, vFindValue, .FindWhat, 0) &gt; 0 )
  462. Else
  463. bFound = ( InStr(vFindValue, .FindWhat) &gt; 0 )
  464. End If
  465. Case acEntire
  466. If .MatchCase Then
  467. bFound = ( .FindWhat = vFindValue )
  468. Else
  469. bFound = ( UCase(.FindWhat) = UCase(vFindValue) )
  470. End If
  471. End Select
  472. Else
  473. bFound = False
  474. End If
  475. End Select
  476. If bFound Then
  477. .LastColumn = i
  478. Exit For
  479. End If
  480. Next i
  481. End If
  482. Loop While Not bFound
  483. .LastRow = lFindRow
  484. If bFound Then
  485. ocGrid.Controls(.ColumnNames(.LastColumn)).setFocus()
  486. .FindRecord = 1
  487. FindNext = True
  488. End If
  489. End With
  490. Exit_Function:
  491. Utils._ResetCalledSub(&quot;FindNext&quot;)
  492. Exit Function
  493. Error_Function:
  494. TraceError(TRACEABORT, Err, &quot;FindNext&quot;, Erl)
  495. GoTo Exit_Function
  496. Error_FindRecord:
  497. TraceError(TRACEERRORS, ERRFINDRECORD, Utils._CalledSub(), 0)
  498. Goto Exit_Function
  499. End Function &apos; FindNext V1.1.0
  500. REM -----------------------------------------------------------------------------------------------------------------------
  501. Public Function FindRecord(Optional ByVal pvFindWhat As Variant _
  502. , Optional ByVal pvMatch As Variant _
  503. , Optional ByVal pvMatchCase As Variant _
  504. , Optional ByVal pvSearch As Variant _
  505. , Optional ByVal pvSearchAsFormatted As Variant _
  506. , Optional ByVal pvTargetedField As Variant _
  507. , Optional ByVal pvFindFirst As Variant _
  508. ) As Boolean
  509. &apos;Find a value (string or other) in the underlying data of a gridcontrol
  510. &apos;Search in all columns or only in one single control
  511. &apos; see pvTargetedField = acAll or acCurrent
  512. &apos; pvTargetedField may also be a shortcut to a GridControl or one of its subcontrols
  513. &apos;Initialize _Findrecord structure in Database root and call FindNext() to set cursor on found value
  514. If _ErrorHandler() Then On Local Error Goto Error_Function
  515. FindRecord = False
  516. Utils._SetCalledSub(&quot;FindRecord&quot;)
  517. If IsMissing(pvFindWhat) Or pvFindWhat = &quot;&quot; Then Call _TraceArguments()
  518. If IsMissing(pvMatch) Then pvMatch = acEntire
  519. If IsMissing(pvMatchCase) Then pvMatchCase = False
  520. If IsMissing(pvSearch) Then pvSearch = acSearchAll
  521. If IsMissing(pvSearchAsFormatted) Then pvSearchAsFormatted = False &apos; Anyway only False supported
  522. If IsMissing(pvTargetedField) Then pvTargetedField = acCurrent
  523. If IsMissing(pvFindFirst) Then pvFindFirst = True
  524. If Not (Utils._CheckArgument(pvFindWhat, 1, Utils._AddNumeric(Array(vbString, vbDate))) _
  525. And Utils._CheckArgument(pvMatch, 2, Utils._AddNumeric(), Array(acAnywhere, acEntire, acStart)) _
  526. And Utils._CheckArgument(pvMatchCase, 3, vbBoolean) _
  527. And Utils._CheckArgument(pvSearch, 4, Utils._AddNumeric(), Array(acDown, acSearchAll, acUp)) _
  528. And Utils._CheckArgument(pvSearchAsFormatted, 5, vbBoolean, Array(False)) _
  529. And Utils._CheckArgument(pvTargetedField, 6, Utils._AddNumeric(vbString)) _
  530. And Utils._CheckArgument(pvFindFirst, 7, vbBoolean) _
  531. ) Then Exit Function
  532. If VarType(pvTargetedField) &lt;&gt; vbString Then
  533. If Not Utils._CheckArgument(pvTargetedField, 6, Utils._AddNumeric(), Array(acAll, acCurrent)) Then Exit Function
  534. End If
  535. Dim ocTarget As Object, i As Integer, j As Integer, vNames() As Variant, iCount As Integer, vIndexes() As Variant
  536. Dim vColumn As Variant, vDataField As Variant, ofParentForm As Variant, oColumns As Object, vParentGrid As Object
  537. Dim bFound As Boolean, ocGridControl As Object, iFocus As Integer
  538. Dim oFindRecord As _FindParams
  539. With oFindRecord
  540. .FindRecord = 0
  541. .FindWhat = pvFindWhat
  542. .Match = pvMatch
  543. .MatchCase = pvMatchCase
  544. .Search = pvSearch
  545. .SearchAsFormatted = pvSearchAsFormatted
  546. .FindFirst = pvFindFirst
  547. &apos; Determine target
  548. &apos; Either: pvTargetedField = Grid =&gt; search all fields
  549. &apos; pvTargetedField = Control in Grid =&gt; search only in that column
  550. &apos; pvTargetedField = acAll or acCurrent =&gt; determine focus
  551. Select Case True
  552. Case VarType(pvTargetedField) = vbString
  553. Set ocTarget = getObject(pvTargetedField)
  554. If ocTarget.SubType = CTLGRIDCONTROL Then
  555. .OnlyCurrentField = acAll
  556. .GridControl = ocTarget._Shortcut
  557. .Target = .GridControl
  558. ofParentForm = getObject(_getUpperShortcut(ocTarget._Shortcut, ocTarget._Name))
  559. If IsNull(ofParentForm.DatabaseForm) Then Goto Error_DatabaseForm
  560. Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns
  561. iCount = -1
  562. For i = 0 To ocTarget.ControlModel.Count - 1
  563. Set vColumn = ocTarget.ControlModel.getByIndex(i)
  564. Set vDataField = vColumn.BoundField &apos; examine field type
  565. If Not IsNull(vDataField) Then
  566. If _CheckColumnType(pvFindWhat, vDataField) Then
  567. iCount = iCount + 1
  568. ReDim Preserve vNames(0 To iCount)
  569. vNames(iCount) = vColumn.Name
  570. ReDim Preserve vIndexes(0 To iCount)
  571. For j = 0 To oColumns.Count - 1
  572. If vDataField.Name = oColumns.ElementNames(j) Then
  573. vIndexes(iCount) = j + 1
  574. Exit For
  575. End If
  576. Next j
  577. End If
  578. End If
  579. Next i
  580. ElseIf ocTarget._Type = OBJCONTROL Then &apos; Control within a grid tbc
  581. If IsNull(ocTarget.ControlModel.BoundField) Then Goto Error_Target &apos; Control MUST be bound to a database record or query
  582. &apos; BoundField is in ControlModel, thanks PASTIM !
  583. .OnlyCurrentField = acCurrent
  584. vParentGrid = getObject(_getUpperShortcut(ocTarget._Shortcut, ocTarget._Name))
  585. If vParentGrid.SubType &lt;&gt; CTLGRIDCONTROL Then Goto Error_Target
  586. .GridControl = vParentGrid._Shortcut
  587. ofParentForm = getObject(_getUpperShortcut(vParentGrid._Shortcut, vParentGrid._Name))
  588. If ofParentForm._Type = OBJCONTROL Then Set ofParentForm = ofParentForm.Form &apos; Bug Tombola
  589. If IsNull(ofParentForm.DatabaseForm) Then Goto Error_DatabaseForm
  590. .Target = ocTarget._Shortcut
  591. Set vDataField = ocTarget.ControlModel.BoundField
  592. If Not _CheckColumnType(pvFindWhat, vDataField) Then Goto Error_Target
  593. ReDim vNames(0), vIndexes(0)
  594. vNames(0) = ocTarget._Name
  595. Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns
  596. For j = 0 To oColumns.Count - 1
  597. If vDataField.Name = oColumns.ElementNames(j) Then
  598. vIndexes(0) = j + 1
  599. Exit For
  600. End If
  601. Next j
  602. End If
  603. Case Else &apos; Determine focus
  604. iCount = Application.Forms()._Count
  605. If iCount = 0 Then Goto Error_ActiveForm
  606. bFound = False
  607. For i = 0 To iCount - 1 &apos; Determine form having the focus
  608. Set ofParentForm = Application.Forms(i)
  609. If ofParentForm.Component.CurrentController.Frame.IsActive() Then
  610. bFound = True
  611. Exit For
  612. End If
  613. Next i
  614. If Not bFound Then Goto Error_ActiveForm
  615. If IsNull(ofParentForm.DatabaseForm) Then Goto Error_DatabaseForm
  616. iCount = ofParentForm.Controls().Count
  617. bFound = False
  618. For i = 0 To iCount - 1
  619. Set ocGridControl = ofParentForm.Controls(i)
  620. If ocGridControl.SubType = CTLGRIDCONTROL Then
  621. bFound = True
  622. Exit For
  623. End If
  624. Next i
  625. If Not bFound Then Goto Error_NoGrid
  626. .GridControl= ocGridControl._Shortcut
  627. iFocus = -1
  628. iFocus = ocGridControl.ControlView.getCurrentColumnPosition() &apos; Deprecated but no alternative found !!
  629. If pvTargetedField = acAll Or iFocus &lt; 0 Or iFocus &gt;= ocGridControl.ControlModel.Count Then &apos; Has a control within the grid the focus ? NO
  630. .OnlyCurrentField = acAll
  631. Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns
  632. iCount = -1
  633. For i = 0 To ocGridControl.ControlModel.Count - 1
  634. Set vColumn = ocGridControl.ControlModel.getByIndex(i)
  635. Set vDataField = vColumn.BoundField &apos; examine field type
  636. If Not IsNull(vDataField) Then
  637. If _CheckColumnType(pvFindWhat, vDataField) Then
  638. iCount = iCount + 1
  639. ReDim Preserve vNames(0 To iCount)
  640. vNames(iCount) = vColumn.Name
  641. ReDim Preserve vIndexes(0 To iCount)
  642. For j = 0 To oColumns.Count - 1
  643. If vDataField.Name = oColumns.ElementNames(j) Then
  644. vIndexes(iCount) = j + 1
  645. Exit For
  646. End If
  647. Next j
  648. End If
  649. End If
  650. Next i
  651. Else &apos; Has a control within the grid the focus ? YES
  652. .OnlyCurrentField = acCurrent
  653. Set vColumn = ocGridControl.ControlModel.getByIndex(iFocus)
  654. Set ocTarget = ocGridControl.Controls(vColumn.Name)
  655. .Target = ocTarget._Shortcut
  656. Set vDataField = ocTarget.ControlModel.BoundField
  657. If IsNull(vDataField) Then Goto Error_Target &apos; Control MUST be bound to a database record or query
  658. If Not _CheckColumnType(pvFindWhat, vDataField) Then Goto Error_Target
  659. ReDim vNames(0), vIndexes(0)
  660. vNames(0) = ocTarget._Name
  661. Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns
  662. For j = 0 To oColumns.Count - 1
  663. If vDataField.Name = oColumns.ElementNames(j) Then
  664. vIndexes(0) = j + 1
  665. Exit For
  666. End If
  667. Next j
  668. End If
  669. End Select
  670. .Form = ofParentForm._Shortcut
  671. .LastColumn = UBound(vNames)
  672. .ColumnNames = vNames
  673. .ResultSetIndex = vIndexes
  674. If pvFindFirst Then
  675. Select Case pvSearch
  676. Case acDown, acSearchAll
  677. ofParentForm.DatabaseForm.beforeFirst()
  678. .LastRow = 0
  679. Case acUp
  680. ofParentForm.DatabaseForm.afterLast()
  681. .LastRow = ofParentForm.DatabaseForm.RowCount + 1
  682. End Select
  683. Else
  684. Select Case True
  685. Case ofParentForm.DatabaseForm.isBeforeFirst And (pvSearch = acSearchAll Or pvSearch = acDown)
  686. .LastRow = 0
  687. Case ofParentForm.DatabaseForm.isAfterLast And pvSearch = acUp
  688. ofParentForm.DatabaseForm.last() &apos; RowCount produces a wrong value as long as last record has not been reached
  689. .LastRow = ofParentForm.DatabaseForm.RowCount + 1
  690. Case Else
  691. .LastRow = ofParentForm.DatabaseForm.getRow()
  692. End Select
  693. End If
  694. .FindRecord = 1
  695. End With
  696. Set _A2B_.FindRecord = oFindRecord
  697. FindRecord = DoCmd.Findnext()
  698. Exit_Function:
  699. Utils._ResetCalledSub(&quot;FindRecord&quot;)
  700. Exit Function
  701. Error_Function:
  702. TraceError(TRACEABORT, Err, &quot;FindRecord&quot;, Erl)
  703. GoTo Exit_Function
  704. Error_ActiveForm:
  705. TraceError(TRACEERRORS, ERRNOACTIVEFORM, Utils._CalledSub(), 0)
  706. Goto Exit_Function
  707. Error_DatabaseForm:
  708. TraceError(TRACEFATAL, ERRDATABASEFORM, Utils._CalledSub(), 0, 1, vParentForm._Name)
  709. Goto Exit_Function
  710. Error_Target:
  711. TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(6, pvTargetedField))
  712. Goto Exit_Function
  713. Error_NoGrid:
  714. TraceError(TRACEFATAL, ERRNOGRIDINFORM, Utils._CalledSub(), 0, 1, vParentForm._Name)
  715. Goto Exit_Function
  716. End Function &apos; FindRecord V1.1.0
  717. REM -----------------------------------------------------------------------------------------------------------------------
  718. Public Function GetHiddenAttribute(ByVal Optional pvObjectType As Variant _
  719. , ByVal Optional pvObjectName As Variant _
  720. ) As Boolean
  721. If _ErrorHandler() Then On Local Error Goto Error_Function
  722. Const cstThisSub = &quot;GetHiddenAttribute&quot;
  723. Utils._SetCalledSub(cstThisSub)
  724. If IsMissing(pvObjectType) Then Call _TraceArguments()
  725. If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _
  726. Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow, acDocument) _
  727. ) Then Goto Exit_Function
  728. If IsMissing(pvObjectName) Then
  729. Select Case pvObjectType
  730. Case acForm, acQuery, acTable, acReport, acDocument : Call _TraceArguments()
  731. Case Else
  732. End Select
  733. pvObjectName = &quot;&quot;
  734. Else
  735. If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
  736. End If
  737. Dim oWindow As Object
  738. Set oWindow = _SelectWindow(pvObjectType, pvObjectName)
  739. If IsNull(oWindow.Frame) Then Goto Error_NotFound
  740. GetHiddenAttribute = Not oWindow.Frame.ContainerWindow.isVisible()
  741. Exit_Function:
  742. Utils._ResetCalledSub(cstThisSub)
  743. Exit Function
  744. Error_NotFound:
  745. TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;OBJECT&quot;), pvObjectName))
  746. Goto Exit_Function
  747. Error_Function:
  748. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  749. GoTo Exit_Function
  750. End Function &apos; GetHiddenAttribute V1.1.0
  751. REM -----------------------------------------------------------------------------------------------------------------------
  752. Public Function GoToControl(Optional ByVal pvControlName As Variant) As Boolean
  753. &apos; Set the focus on the named control on the active form.
  754. &apos; Return False if the control does not exist or is disabled,
  755. If _ErrorHandler() Then On Local Error Goto Error_Function
  756. Utils._SetCalledSub(&quot;GoToControl&quot;)
  757. If IsMissing(pvControlName) Then Call _TraceArguments()
  758. If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function
  759. GoToControl = False
  760. Dim oWindow As Object, ofForm As Object, ocControl As Object
  761. Dim i As Integer, iCount As Integer
  762. Set oWindow = _SelectWindow()
  763. If oWindow.WindowType = acForm Then
  764. Set ofForm = Application.Forms(oWindow._Name)
  765. iCount = ofForm.Controls().Count
  766. For i = 0 To iCount - 1
  767. ocControl = ofForm.Controls(i)
  768. If UCase(ocControl._Name) = UCase(pvControlName) Then
  769. If Methods.hasProperty(ocControl, &quot;Enabled&quot;) Then
  770. If ocControl.Enabled Then
  771. ocControl.setFocus()
  772. GoToControl = True
  773. Exit For
  774. End If
  775. End If
  776. End If
  777. Next i
  778. End If
  779. Exit_Function:
  780. Utils._ResetCalledSub(&quot;GoToControl&quot;)
  781. Exit Function
  782. Error_Function:
  783. TraceError(TRACEABORT, Err, &quot;GoToControl&quot;, Erl)
  784. GoTo Exit_Function
  785. End Function &apos; GoToControl V0.9.0
  786. REM -----------------------------------------------------------------------------------------------------------------------
  787. Public Function GoToRecord(Optional ByVal pvObjectType As Variant _
  788. , Optional ByVal pvObjectName As Variant _
  789. , Optional ByVal pvRecord As Variant _
  790. , Optional ByVal pvOffset As Variant _
  791. ) As Boolean
  792. &apos;Move to record indicated by pvRecord/pvOffset in the window designated by pvObjectType and pvObjectName
  793. If _ErrorHandler() Then On Local Error Goto Error_Function
  794. GoToRecord = False
  795. Const cstThisSub = &quot;GoTorecord&quot;
  796. Utils._SetCalledSub(cstThisSub)
  797. If IsMissing(pvObjectName) Then pvObjectName = &quot;&quot;
  798. If IsMissing(pvObjectType) Then pvObjectType = acActiveDataObject
  799. If IsMissing(pvRecord) Then pvRecord = acNext
  800. If IsMissing(pvOffset) Then pvOffset = 1
  801. If Not (Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric() _
  802. , Array(acActiveDataObject, acDataForm, acDataQuery, acDataTable)) _
  803. And Utils._CheckArgument(pvObjectName, 2, vbString) _
  804. And Utils._CheckArgument(pvRecord, 3, Utils._AddNumeric() _
  805. , Array(acFirst, acGoTo, acLast, acNewRec, acNext, acPrevious)) _
  806. And Utils._CheckArgument(pvOffset, 4, Utils._AddNumeric()) _
  807. ) Then Goto Exit_Function
  808. If pvObjectType = acActiveDataObject And pvObjectName &lt;&gt; &quot;&quot; Then Goto Error_Target
  809. If pvOffset &lt; 0 And pvRecord &lt;&gt; acGoTo Then Goto Error_Offset
  810. Dim ofForm As Object, oGeneric As Object, oResultSet As Object, oWindow As Object
  811. Dim i As Integer, iCount As Integer, bFound As Boolean, lOffset As Long
  812. Dim sObjectName, iLengthName As Integer
  813. Select Case pvObjectType
  814. Case acActiveDataObject
  815. Set oWindow = _SelectWindow()
  816. With oWindow
  817. Select Case .WindowType
  818. Case acForm
  819. Set oResultSet = _DatabaseForm(._Name, &quot;&quot;)
  820. Case acQuery, acTable
  821. If IsNull(.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
  822. &apos; FormOperations returns &lt;Null&gt; in OpenOffice
  823. Set oResultSet = .Frame.Controller.FormOperations.Cursor
  824. Case Else &apos; Ignore action
  825. Goto Exit_Function
  826. End Select
  827. End With
  828. Case acDataForm
  829. &apos; pvObjectName can be &quot;myForm&quot;, &quot;Forms!myForm&quot;, &quot;Forms!myForm!mySubform&quot; or &quot;Forms!myForm!mySubform.Form&quot;
  830. sObjectName = UCase(pvObjectName)
  831. iLengthName = Len(sObjectName)
  832. Select Case True
  833. Case iLengthName &gt; 6 And Left(sObjectName, 6) = &quot;FORMS!&quot; And Right(sObjectName, 5) = &quot;.FORM&quot;
  834. Set ofForm = getObject(pvObjectName)
  835. If ofForm._Type &lt;&gt; OBJSUBFORM Then Goto Error_Target
  836. Case iLengthName &gt; 6 And Left(sObjectName, 6) = &quot;FORMS!&quot;
  837. Set oGeneric = getObject(pvObjectName)
  838. If oGeneric._Type = OBJFORM Or oGeneric._Type = OBJSUBFORM Then
  839. Set ofForm = oGeneric
  840. ElseIf oGeneric.SubType = CTLSUBFORM Then
  841. Set ofForm = oGeneric.Form
  842. Else Goto Error_Target
  843. End If
  844. Case sObjectName = &quot;&quot;
  845. Call _TraceArguments()
  846. Case Else
  847. Set ofForm = Application.Forms(pvObjectName)
  848. End Select
  849. Set oResultSet = ofForm.DatabaseForm
  850. Case acDataQuery
  851. Set oWindow = _SelectWindow(acQuery, pvObjectName)
  852. If IsNull(oWindow.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
  853. &apos; FormOperations returns &lt;Null&gt; in OpenOffice
  854. Set oResultSet = oWindow.Frame.Controller.FormOperations.Cursor
  855. Case acDataTable
  856. Set oWindow = _SelectWindow(acTable, pvObjectName)
  857. If IsNull(oWindow.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
  858. Set oResultSet = oWindow.Frame.Controller.FormOperations.Cursor
  859. Case Else
  860. End Select
  861. &apos; Check if current row updated =&gt; Save it
  862. If oResultSet.IsNew Then
  863. oResultSet.insertRow()
  864. ElseIf oResultSet.IsModified Then
  865. oResultSet.updateRow()
  866. End If
  867. lOffset = pvOffset
  868. Select Case pvRecord
  869. Case acFirst : GoToRecord = oResultSet.first()
  870. Case acGoTo : GoToRecord = oResultSet.absolute(lOffset)
  871. Case acLast : GoToRecord = oResultSet.last()
  872. Case acNewRec
  873. oResultSet.last() &apos; To simulate the behaviour in the UI
  874. oResultSet.moveToInsertRow()
  875. GoToRecord = True
  876. Case acNext
  877. If lOffset = 1 Then
  878. GoToRecord = oResultSet.next()
  879. Else
  880. GoToRecord = oResultSet.relative(lOffset)
  881. End If
  882. Case acPrevious
  883. If lOffset = 1 Then
  884. GoToRecord = oResultSet.previous()
  885. Else
  886. GoToRecord = oResultSet.relative(- lOffset)
  887. End If
  888. End Select
  889. Exit_Function:
  890. Utils._ResetCalledSub(cstThisSub)
  891. Exit Function
  892. Error_Function:
  893. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  894. GoTo Exit_Function
  895. Error_Target:
  896. TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(2, pvObjectName))
  897. Goto Exit_Function
  898. Error_Offset:
  899. TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(4, pvOffset))
  900. Goto Exit_Function
  901. Error_NotApplicable:
  902. TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
  903. Goto Exit_Function
  904. End Function &apos; GoToRecord
  905. REM -----------------------------------------------------------------------------------------------------------------------
  906. Public Function Maximize() As Boolean
  907. &apos; Maximize the window having the focus
  908. Utils._SetCalledSub(&quot;Maximize&quot;)
  909. Dim oWindow As Object
  910. Maximize = False
  911. Set oWindow = _SelectWindow()
  912. If Not IsNull(oWindow.Frame) Then
  913. If Utils._hasUNOProperty(oWindow.Frame.ContainerWindow, &quot;IsMaximized&quot;) Then oWindow.Frame.ContainerWindow.IsMaximized = True &apos; Ignored when &lt;= OO3.2
  914. Maximize = True
  915. End If
  916. Utils._ResetCalledSub(&quot;Maximize&quot;)
  917. Exit Function
  918. End Function &apos; Maximize V0.8.5
  919. REM -----------------------------------------------------------------------------------------------------------------------
  920. Public Function Minimize() As Boolean
  921. &apos; Maximize the form having the focus
  922. Utils._SetCalledSub(&quot;Minimize&quot;)
  923. Dim oWindow As Object
  924. Minimize = False
  925. Set oWindow = _SelectWindow()
  926. If Not IsNull(oWindow.Frame) Then
  927. If Utils._hasUNOProperty(oWindow.Frame.ContainerWindow, &quot;IsMinimized&quot;) Then oWindow.Frame.ContainerWindow.IsMinimized = True
  928. Minimize = True
  929. End If
  930. Utils._ResetCalledSub(&quot;Minimize&quot;)
  931. Exit Function
  932. End Function &apos; Minimize V0.8.5
  933. REM -----------------------------------------------------------------------------------------------------------------------
  934. Public Function MoveSize(ByVal Optional pvLeft As Variant _
  935. , ByVal Optional pvTop As Variant _
  936. , ByVal Optional pvWidth As Variant _
  937. , ByVal Optional pvHeight As Variant _
  938. ) As Variant
  939. &apos; Execute MoveSize action
  940. If _ErrorHandler() Then On Local Error Goto Error_Function
  941. Utils._SetCalledSub(&quot;MoveSize&quot;)
  942. MoveSize = False
  943. If IsMissing(pvLeft) Then pvLeft = -1
  944. If IsMissing(pvTop) Then pvTop = -1
  945. If IsMissing(pvWidth) Then pvWidth = -1
  946. If IsMissing(pvHeight) Then pvHeight = -1
  947. If Not Utils._CheckArgument(pvLeft, 1, Utils._AddNumeric()) Then Goto Exit_Function
  948. If Not Utils._CheckArgument(pvTop, 2, Utils._AddNumeric()) Then Goto Exit_Function
  949. If Not Utils._CheckArgument(pvWidth, 3, Utils._AddNumeric()) Then Goto Exit_Function
  950. If Not Utils._CheckArgument(pvHeight, 4, Utils._AddNumeric()) Then Goto Exit_Function
  951. Dim iArg As Integer, iWrong As Integer &apos; Check arguments values
  952. iArg = 0
  953. If pvHeight &lt; -1 Then
  954. iArg = 4 : iWrong = pvHeight
  955. ElseIf pvWidth &lt; -1 Then
  956. iArg = 3 : iWrong = pvWidth
  957. ElseIf pvTop &lt; -1 Then
  958. iArg = 2 : iWrong = pvTop
  959. ElseIf pvLeft &lt; -1 Then
  960. iArg = 1 : iWrong = pvLeft
  961. End If
  962. If iArg &gt; 0 Then
  963. TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(iArg, iWrong))
  964. Goto Exit_Function
  965. End If
  966. Dim iPosSize As Integer
  967. iPosSize = 0
  968. If pvLeft &gt;= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X
  969. If pvTop &gt;= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y
  970. If pvWidth &gt; 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH
  971. If pvHeight &gt; 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT
  972. Dim oWindow As Object
  973. Set oWindow = _SelectWindow()
  974. With oWindow
  975. If Not IsNull(.Frame) Then
  976. If Utils._hasUNOProperty(.Frame.ContainerWindow, &quot;IsMaximized&quot;) Then &apos; Ignored when &lt;= OO3.2
  977. .Frame.ContainerWindow.IsMaximized = False
  978. .Frame.ContainerWindow.IsMinimized = False
  979. End If
  980. .Frame.ContainerWindow.setPosSize(pvLeft, pvTop, pvWidth, pvHeight, iPosSize)
  981. MoveSize = True
  982. End If
  983. End With
  984. Exit_Function:
  985. Utils._ResetCalledSub(&quot;MoveSize&quot;)
  986. Exit Function
  987. Error_Function:
  988. TraceError(TRACEABORT, Err, &quot;MoveSize&quot;, Erl)
  989. GoTo Exit_Function
  990. End Function &apos; MoveSize V1.1.0
  991. REM -----------------------------------------------------------------------------------------------------------------------
  992. Public Function OpenForm(Optional ByVal pvFormName As Variant _
  993. , Optional ByVal pvView As Variant _
  994. , Optional ByVal pvFilterName As Variant _
  995. , Optional ByVal pvWhereCondition As Variant _
  996. , Optional ByVal pvDataMode As Variant _
  997. , Optional ByVal pvWindowMode As Variant _
  998. , Optional ByVal pvOpenArgs As Variant _
  999. ) As Variant
  1000. If _ErrorHandler() Then On Local Error Goto Error_Function
  1001. Utils._SetCalledSub(&quot;OpenForm&quot;)
  1002. If IsMissing(pvFormName) Then Call _TraceArguments()
  1003. If IsMissing(pvView) Then pvView = acNormal
  1004. If IsMissing(pvFilterName) Then pvFilterName = &quot;&quot;
  1005. If IsMissing(pvWhereCondition) Then pvWhereCondition = &quot;&quot;
  1006. If IsMissing(pvDataMode) Then pvDataMode = acFormPropertySettings
  1007. If IsMissing(pvWindowMode) Then pvWindowMode = acWindowNormal
  1008. If IsMissing(pvOpenArgs) Then pvOpenArgs = &quot;&quot;
  1009. Set OpenForm = Nothing
  1010. If Not (Utils._CheckArgument(pvFormName, 1, vbString) _
  1011. And Utils._CheckArgument(pvView, 2, Utils._AddNumeric(), Array(acNormal, acPreview, acDesign)) _
  1012. And Utils._CheckArgument(pvFilterName, 3, vbString) _
  1013. And Utils._CheckArgument(pvWhereCondition, 4, vbString) _
  1014. And Utils._CheckArgument(pvDataMode, 5, Utils._AddNumeric(), Array(acFormAdd, acFormEdit, acFormPropertySettings, acFormReadOnly)) _
  1015. And Utils._CheckArgument(pvWindowMode, 6, Utils._AddNumeric(), Array(acDialog, acHidden, acIcon, acWindowNormal)) _
  1016. ) Then Goto Exit_Function
  1017. Dim ofForm As Object, sWarning As String
  1018. Dim oDatabase As Object, oOpenForm As Object, bOpenMode As Boolean, oController As Object
  1019. Set oDatabase = Application._CurrentDb()
  1020. If oDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
  1021. Set ofForm = Application.AllForms(pvFormName)
  1022. If ofForm.IsLoaded Then
  1023. sWarning = _GetLabel(&quot;ERR&quot; &amp; ERRFORMYETOPEN)
  1024. sWarning = Join(Split(sWarning, &quot;%0&quot;), ofForm._Name)
  1025. TraceLog(TRACEANY, &quot;OpenForm: &quot; &amp; sWarning)
  1026. Set OpenForm = ofForm
  1027. Goto Exit_Function
  1028. End If
  1029. &apos; Open the form
  1030. Select Case pvView
  1031. Case acNormal, acPreview: bOpenMode = False
  1032. Case acDesign : bOpenMode = True
  1033. End Select
  1034. Set oController = oDatabase.Document.CurrentController
  1035. Set oOpenForm = oController.loadComponent(com.sun.star.sdb.application.DatabaseObject.FORM, ofForm._Name, bOpenMode)
  1036. &apos; Apply the filters (FilterName) AND (WhereCondition)
  1037. Dim sFilter As String, oForm As Object, oFormsCollection As Object
  1038. If pvFilterName = &quot;&quot; And pvWhereCondition = &quot;&quot; Then
  1039. sFilter = &quot;&quot;
  1040. ElseIf pvFilterName = &quot;&quot; Or pvWhereCondition = &quot;&quot; Then
  1041. sFilter = pvFilterName &amp; pvWhereCondition
  1042. Else
  1043. sFilter = &quot;(&quot; &amp; pvFilterName &amp; &quot;) And (&quot; &amp; pvWhereCondition &amp; &quot;)&quot;
  1044. End If
  1045. Set oFormsCollection = oOpenForm.DrawPage.Forms
  1046. If oFormsCollection.getCount() &gt; 0 Then Set oForm = oFormsCollection.getByIndex(0) Else Set oForm = Nothing
  1047. If Not IsNull(oForm) Then
  1048. If sFilter &lt;&gt; &quot;&quot; Then
  1049. oForm.Filter = oDatabase._ReplaceSquareBrackets(sFilter)
  1050. oForm.ApplyFilter = True
  1051. oForm.reload()
  1052. ElseIf oForm.Filter &lt;&gt; &quot;&quot; Then &apos; If a filter has been set previously it must be removed
  1053. oForm.Filter = &quot;&quot;
  1054. oForm.ApplyFilter = False
  1055. oForm.reload()
  1056. End If
  1057. End If
  1058. &apos;Housekeeping
  1059. Set ofForm = Application.AllForms(pvFormName) &apos; Redone to reinitialize all properties of ofForm now FormName is open
  1060. With ofForm
  1061. If Not IsNull(.DatabaseForm) Then
  1062. Select Case pvDataMode
  1063. Case acFormAdd
  1064. .AllowAdditions = True
  1065. .AllowDeletions = False
  1066. .AllowEdits = False
  1067. Case acFormEdit
  1068. .AllowAdditions = True
  1069. .AllowDeletions = True
  1070. .AllowEdits = True
  1071. Case acFormReadOnly
  1072. .AllowAdditions = False
  1073. .AllowDeletions = False
  1074. .AllowEdits = False
  1075. Case acFormPropertySettings
  1076. End Select
  1077. End If
  1078. .Visible = ( pvWindowMode &lt;&gt; acHidden )
  1079. ._OpenArgs = pvOpenArgs
  1080. &apos;To avoid AOO 3.4 bug See http://user.services.openoffice.org/en/forum/viewtopic.php?f=13&amp;t=53751
  1081. .Component.CurrentController.ViewSettings.ShowOnlineLayout = True
  1082. End With
  1083. Set OpenForm = ofForm
  1084. Exit_Function:
  1085. Utils._ResetCalledSub(&quot;OpenForm&quot;)
  1086. Set ofForm = Nothing
  1087. Set oOpenForm = Nothing
  1088. Exit Function
  1089. Error_Function:
  1090. TraceError(TRACEABORT, Err, &quot;OpenForm&quot;, Erl)
  1091. Set OpenForm = Nothing
  1092. GoTo Exit_Function
  1093. Error_NotApplicable:
  1094. TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1)
  1095. Goto Exit_Function
  1096. Trace_Error:
  1097. TraceError(TRACEFATAL, ERROPENFORM, Utils._CalledSub(), 0, , pvFormName)
  1098. Set OpenForm = Nothing
  1099. Goto Exit_Function
  1100. End Function &apos; OpenForm V0.9.0
  1101. REM -----------------------------------------------------------------------------------------------------------------------
  1102. Public Function OpenQuery(Optional ByVal pvQueryName As Variant _
  1103. , Optional ByVal pvView As Variant _
  1104. , Optional ByVal pvDataMode As Variant _
  1105. ) As Boolean
  1106. If _ErrorHandler() Then On Local Error Goto Error_Function
  1107. Utils._SetCalledSub(&quot;OpenQuery&quot;)
  1108. If IsMissing(pvQueryName) Then Call _TraceArguments()
  1109. If IsMissing(pvView) Then pvView = acViewNormal
  1110. If IsMissing(pvDataMode) Then pvDataMode = acEdit
  1111. OpenQuery = DoCmd._OpenObject(&quot;Query&quot;, pvQueryName, pvView, pvDataMode)
  1112. Exit_Function:
  1113. Utils._ResetCalledSub(&quot;OpenQuery&quot;)
  1114. Exit Function
  1115. Error_Function:
  1116. TraceError(TRACEABORT, Err, &quot;OpenQuery&quot;, Erl)
  1117. GoTo Exit_Function
  1118. End Function &apos; OpenQuery
  1119. REM -----------------------------------------------------------------------------------------------------------------------
  1120. Public Function OpenReport(Optional ByVal pvReportName As Variant _
  1121. , Optional ByVal pvView As Variant _
  1122. , Optional ByVal pvDataMode As Variant _
  1123. ) As Boolean
  1124. If _ErrorHandler() Then On Local Error Goto Error_Function
  1125. Utils._SetCalledSub(&quot;OpenReport&quot;)
  1126. If IsMissing(pvReportName) Then Call _TraceArguments()
  1127. If IsMissing(pvView) Then pvView = acViewNormal
  1128. If IsMissing(pvDataMode) Then pvDataMode = acEdit
  1129. OpenReport = DoCmd._OpenObject(&quot;Report&quot;, pvReportName, pvView, pvDataMode)
  1130. Exit_Function:
  1131. Utils._ResetCalledSub(&quot;OpenReport&quot;)
  1132. Exit Function
  1133. Error_Function:
  1134. TraceError(TRACEABORT, Err, &quot;OpenReport&quot;, Erl)
  1135. GoTo Exit_Function
  1136. End Function &apos; OpenReport
  1137. REM -----------------------------------------------------------------------------------------------------------------------
  1138. Public Function OpenSQL(Optional ByVal pvSQL As Variant _
  1139. , Optional ByVal pvOption As Variant _
  1140. ) As Boolean
  1141. &apos; Return True if the execution of the SQL statement was successful
  1142. &apos; SQL must contain a SELECT query
  1143. &apos; pvOption can force pass through mode
  1144. If _ErrorHandler() Then On Local Error Goto Error_Function
  1145. Utils._SetCalledSub(&quot;OpenSQL&quot;)
  1146. OpenSQL = False
  1147. If IsMissing(pvSQL) Then Call _TraceArguments()
  1148. If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function
  1149. Const cstNull = -1
  1150. If IsMissing(pvOption) Then
  1151. pvOption = cstNull
  1152. Else
  1153. If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function
  1154. End If
  1155. OpenSQL = Application._CurrentDb.OpenSQL(pvSQL, pvOption)
  1156. Exit_Function:
  1157. Utils._ResetCalledSub(&quot;OpenSQL&quot;)
  1158. Exit Function
  1159. Error_Function:
  1160. TraceError(TRACEABORT, Err, &quot;OpenSQL&quot;, Erl)
  1161. GoTo Exit_Function
  1162. End Function &apos; OpenSQL V1.1.0
  1163. REM -----------------------------------------------------------------------------------------------------------------------
  1164. Public Function OpenTable(Optional ByVal pvTableName As Variant _
  1165. , Optional ByVal pvView As Variant _
  1166. , Optional ByVal pvDataMode As Variant _
  1167. ) As Boolean
  1168. If _ErrorHandler() Then On Local Error Goto Error_Function
  1169. Utils._SetCalledSub(&quot;OpenTable&quot;)
  1170. If IsMissing(pvTableName) Then Call _TraceArguments()
  1171. If IsMissing(pvView) Then pvView = acViewNormal
  1172. If IsMissing(pvDataMode) Then pvDataMode = acEdit
  1173. OpenTable = DoCmd._OpenObject(&quot;Table&quot;, pvTableName, pvView, pvDataMode)
  1174. Exit_Function:
  1175. Utils._ResetCalledSub(&quot;OpenTable&quot;)
  1176. Exit Function
  1177. Error_Function:
  1178. TraceError(TRACEABORT, Err, &quot;OpenTable&quot;, Erl)
  1179. GoTo Exit_Function
  1180. End Function &apos; OpenTable
  1181. REM -----------------------------------------------------------------------------------------------------------------------
  1182. Public Function OutputTo(ByVal pvObjectType As Variant _
  1183. , ByVal Optional pvObjectName As Variant _
  1184. , ByVal Optional pvOutputFormat As Variant _
  1185. , ByVal Optional pvOutputFile As Variant _
  1186. , ByVal Optional pvAutoStart As Variant _
  1187. , ByVal Optional pvTemplateFile As Variant _
  1188. , ByVal Optional pvEncoding As Variant _
  1189. , ByVal Optional pvQuality As Variant _
  1190. ) As Boolean
  1191. REM https://wiki.openoffice.org/wiki/Framework/Article/Filter/FilterList_OOo_3_0
  1192. REM https://wiki.documentfoundation.org/Documentation/DevGuide/Spreadsheet_Documents#Filter_Options
  1193. REM https://msdn.microsoft.com/en-us/library/ms709353%28v=vs.85%29.aspx
  1194. &apos;Supported: acFormatPDF, acFormatODT, acFormatDOC, acFormatHTML for forms
  1195. &apos; acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT for tables and queries
  1196. If _ErrorHandler() Then On Local Error Goto Error_Function
  1197. Const cstThisSub = &quot;OutputTo&quot;
  1198. Utils._SetCalledSub(cstThisSub)
  1199. OutputTo = False
  1200. If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery, acOutputForm)) Then Goto Exit_Function
  1201. If IsMissing(pvObjectName) Then pvObjectName = &quot;&quot;
  1202. If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
  1203. If IsMissing(pvOutputFormat) Then pvOutputFormat = &quot;&quot;
  1204. If Not Utils._CheckArgument(pvOutputFormat, 3, vbString) Then Goto Exit_Function
  1205. If pvOutputFormat &lt;&gt; &quot;&quot; Then
  1206. If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _
  1207. UCase(acFormatPDF), UCase(acFormatODT), UCase(acFormatDOC), UCase(acFormatHTML) _
  1208. , UCase(acFormatODS), UCase(acFormatXLS), UCase(acFormatXLSX), UCase(acFormatTXT) _
  1209. , &quot;PDF&quot;, &quot;ODT&quot;, &quot;DOC&quot;, &quot;HTML&quot;, &quot;ODS&quot;, &quot;XLS&quot;, &quot;XLSX&quot;, &quot;TXT&quot;, &quot;CSV&quot;, &quot;&quot; _
  1210. )) Then Goto Exit_Function &apos; A 2nd time to allow case unsensitivity
  1211. End If
  1212. If IsMissing(pvOutputFile) Then pvOutputFile = &quot;&quot;
  1213. If Not Utils._CheckArgument(pvOutputFile, 4, vbString) Then Goto Exit_Function
  1214. If IsMissing(pvAutoStart) Then pvAutoStart = False
  1215. If Not Utils._CheckArgument(pvAutoStart, 5, vbBoolean) Then Goto Exit_Function
  1216. If IsMissing(pvTemplateFile) Then pvTemplateFile = &quot;&quot;
  1217. If Not Utils._CheckArgument(pvTemplateFile, 6, vbString) Then Goto Exit_Function
  1218. If IsMissing(pvEncoding) Then pvEncoding = 0
  1219. If Not Utils._CheckArgument(pvEncoding, 7, _AddNumeric()) Then Goto Exit_Function
  1220. If IsMissing(pvQuality) Then pvQuality = acExportQualityPrint
  1221. If Not Utils._CheckArgument(pvQuality, 7, _AddNumeric(), Array(acExportQualityPrint, acExportQualityScreen)) Then Goto Exit_Function
  1222. If pvObjectType = acOutputTable Or pvObjectType = acOutputQuery Then
  1223. OutputTo = Application._CurrentDb().OutputTo( _
  1224. pvObjectType _
  1225. , pvObjectName _
  1226. , pvOutputFormat _
  1227. , pvOutputFile _
  1228. , pvAutoStart _
  1229. , pvTemplateFile _
  1230. , pvEncoding _
  1231. , pvQuality _
  1232. )
  1233. GoTo Exit_Function
  1234. End If
  1235. Dim vWindow As Variant, sOutputFile As String, ofForm As Object, i As Integer, bFound As Boolean
  1236. &apos;Find applicable form
  1237. If pvObjectName = &quot;&quot; Then
  1238. vWindow = _SelectWindow()
  1239. If vWindow.WindowType &lt;&gt; acOutoutForm Then Goto Error_Action
  1240. Set ofForm = Application.Forms(vWindow._Name)
  1241. Else
  1242. bFound = False
  1243. For i = 0 To Application.Forms()._Count - 1
  1244. Set ofForm = Application.Forms(i)
  1245. If UCase(ofForm._Name) = UCase(pvObjectName) Then
  1246. bFound = True
  1247. Exit For
  1248. End If
  1249. Next i
  1250. If Not bFound Then Goto Error_NotFound
  1251. End If
  1252. &apos;Determine format and parameters
  1253. Dim sOutputFormat As String, sFilter As String, oFilterData As Object, oExport As Object, sSuffix As String
  1254. If pvOutputFormat = &quot;&quot; Then
  1255. sOutputFormat = _PromptFormat(Array(&quot;PDF&quot;, &quot;ODT&quot;, &quot;DOC&quot;, &quot;HTML&quot;)) &apos; Prompt user for format
  1256. If sOutputFormat = &quot;&quot; Then Goto Exit_Function
  1257. Else
  1258. sOutputFormat = UCase(pvOutputFormat)
  1259. End If
  1260. Select Case sOutputFormat
  1261. Case UCase(acFormatPDF), &quot;PDF&quot;
  1262. sFilter = acFormatPDF
  1263. oFilterData = Array( _
  1264. _MakePropertyValue (&quot;ExportFormFields&quot;, False), _
  1265. )
  1266. sSuffix = &quot;pdf&quot;
  1267. Case UCase(acFormatDOC), &quot;DOC&quot;
  1268. sFilter = acFormatDOC
  1269. oFilterData = Array()
  1270. sSuffix = &quot;doc&quot;
  1271. Case UCase(acFormatODT), &quot;ODT&quot;
  1272. sFilter = acFormatODT
  1273. oFilterData = Array()
  1274. sSuffix = &quot;odt&quot;
  1275. Case UCase(acFormatHTML), &quot;HTML&quot;
  1276. sFilter = acFormatHTML
  1277. oFilterData = Array()
  1278. sSuffix = &quot;html&quot;
  1279. End Select
  1280. oExport = Array( _
  1281. _MakePropertyValue(&quot;Overwrite&quot;, True), _
  1282. _MakePropertyValue(&quot;FilterName&quot;, sFilter), _
  1283. _MakePropertyValue(&quot;FilterData&quot;, oFilterData), _
  1284. )
  1285. &apos;Determine output file
  1286. If pvOutputFile = &quot;&quot; Then &apos; Prompt file picker to user
  1287. sOutputFile = _PromptFilePicker(sSuffix)
  1288. If sOutputFile = &quot;&quot; Then Goto Exit_Function
  1289. Else
  1290. sOutputFile = pvOutputFile
  1291. End If
  1292. sOutputFile = ConvertToURL(sOutputFile)
  1293. &apos;Create file
  1294. On Local Error Goto Error_File
  1295. ofForm.Component.storeToURL(sOutputFile, oExport)
  1296. On Local Error Goto Error_Function
  1297. &apos;Launch application, if requested
  1298. If pvAutoStart Then Call _ShellExecute(sOutputFile)
  1299. OutputTo = True
  1300. Exit_Function:
  1301. Utils._ResetCalledSub(cstThisSub)
  1302. Exit Function
  1303. Error_NotFound:
  1304. TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;OBJECT&quot;), pvObjectName))
  1305. Goto Exit_Function
  1306. Error_Action:
  1307. TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0)
  1308. Goto Exit_Function
  1309. Error_Function:
  1310. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  1311. GoTo Exit_Function
  1312. Error_File:
  1313. TraceError(TRACEFATAL, ERRFILENOTCREATED, Utils._CalledSub(), 0, , sOutputFile)
  1314. GoTo Exit_Function
  1315. End Function &apos; OutputTo V0.9.1
  1316. REM -----------------------------------------------------------------------------------------------------------------------
  1317. Public Function Quit(Optional ByVal pvSave As Variant) As Variant
  1318. &apos; Quit the application
  1319. &apos; Modified from Andrew Pitonyak&apos;s Base Macro Programming §5.8.1
  1320. If _ErrorHandler() Then On Local Error Goto Error_Function
  1321. Const cstThisSub = &quot;Quit&quot;
  1322. Utils._SetCalledSub(cstThisSub)
  1323. If IsMissing(pvSave) Then pvSave = acQuitSaveAll
  1324. If Not Utils._CheckArgument(pvSave, 1, Utils._AddNumeric(), _
  1325. Array(acQuitPrompt, acQuitSaveAll, acQuitSaveNone) _
  1326. ) Then Goto Exit_Function
  1327. Dim oDatabase As Object, oDoc As Object
  1328. Set oDatabase = Application._CurrentDb()
  1329. If oDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
  1330. If Not IsNull(oDatabase) Then
  1331. Set oDoc = oDatabase.Document
  1332. Select Case pvSave
  1333. Case acQuitPrompt
  1334. If MsgBox(_GetLabel(&quot;QUIT&quot;), vbYesNo + vbQuestion, _GetLabel(&quot;QUITSHORT&quot;)) = vbNo Then Exit Function
  1335. Case acQuitSaveNone
  1336. oDoc.setModified(False)
  1337. Case Else
  1338. End Select
  1339. If HasUnoInterfaces(oDoc, &quot;com.sun.star.util.XCloseable&quot;) Then
  1340. If (oDoc.isModified) Then
  1341. If (oDoc.hasLocation AND (Not oDoc.isReadOnly)) Then
  1342. oDoc.store()
  1343. End If
  1344. End If
  1345. oDoc.close(true)
  1346. Else
  1347. oDoc.dispose()
  1348. End If
  1349. End If
  1350. Exit_Function:
  1351. Utils._ResetCalledSub(cstThisSub)
  1352. Set oDatabase = Nothing
  1353. Set oDoc = Nothing
  1354. Exit Function
  1355. Error_Function:
  1356. TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
  1357. Set OpenForm = Nothing
  1358. GoTo Exit_Function
  1359. Error_NotApplicable:
  1360. TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
  1361. Goto Exit_Function
  1362. End Function &apos; Quit V1.1.0
  1363. REM -----------------------------------------------------------------------------------------------------------------------
  1364. Public Sub RunApp(Optional ByVal pvCommandLine As Variant)
  1365. &apos; Convert to URL and execute the Command Line
  1366. If _ErrorHandler() Then On Local Error Goto Error_Sub
  1367. Utils._SetCalledSub(&quot;RunApp&quot;)
  1368. If IsMissing(pvCommandLine) Then Call _TraceArguments()
  1369. If Not Utils._CheckArgument(pvCommandLine, 1, vbString) Then Goto Exit_Sub
  1370. _ShellExecute(ConvertToURL(pvCommandLine))
  1371. Exit_Sub:
  1372. Utils._ResetCalledSub(&quot;RunApp&quot;)
  1373. Exit Sub
  1374. Error_Sub:
  1375. TraceError(TRACEABORT, Err, &quot;RunApp&quot;, Erl)
  1376. GoTo Exit_Sub
  1377. End Sub &apos; RunApp V0.8.5
  1378. REM -----------------------------------------------------------------------------------------------------------------------
  1379. Public Function RunCommand(Optional pvCommand As Variant, Optional pbReturnCommand As Boolean) As Variant
  1380. &apos; Execute command via DispatchHelper
  1381. &apos; pbReturnCommand = internal parameter to only return the exact command string (always absent if uno prefix present in pvCommand)
  1382. If _ErrorHandler() Then On Local Error Goto Exit_Function &apos; Avoid any abort
  1383. Const cstThisSub = &quot;RunCommand&quot;
  1384. Utils._SetCalledSub(cstThisSub)
  1385. Dim iVBACommand As Integer, sOOCommand As String, sDispatch As String
  1386. If IsMissing(pvCommand) Then Call _TraceArguments()
  1387. If Not ( Utils._CheckArgument(pvCommand, 1, Utils._AddNumeric(vbString)) ) Then Goto Exit_Function
  1388. If IsMissing(pbReturnCommand) Then pbReturnCommand = False
  1389. RunCommand = True
  1390. Const cstUnoPrefix = &quot;.uno:&quot;
  1391. If VarType(pvCommand) = vbString Then
  1392. sOOCommand = pvCommand
  1393. iVBACommand = -1
  1394. If _IsLeft(sOOCommand, cstUnoPrefix) Then
  1395. Call _DispatchCommand(sOOCommand)
  1396. Goto Exit_Function
  1397. End If
  1398. Else
  1399. sOOCommand = &quot;&quot;
  1400. iVBACommand = pvCommand
  1401. End If
  1402. Select Case True
  1403. Case iVBACommand = acCmdAboutMicrosoftAccess Or UCase(sOOCommand) = &quot;ABOUT&quot; : sDispatch = &quot;About&quot;
  1404. Case iVBACommand = acCmdAboutOpenOffice Or UCase(sOOCommand) = &quot;ABOUT&quot; : sDispatch = &quot;About&quot;
  1405. Case iVBACommand = acCmdAboutLibreOffice Or UCase(sOOCommand) = &quot;ABOUT&quot; : sDispatch = &quot;About&quot;
  1406. Case UCase(sOOCommand) = &quot;ACTIVEHELP&quot; : sDispatch = &quot;ActiveHelp&quot;
  1407. Case UCase(sOOCommand) = &quot;ADDDIRECT&quot; : sDispatch = &quot;AddDirect&quot;
  1408. Case UCase(sOOCommand) = &quot;ADDFIELD&quot; : sDispatch = &quot;AddField&quot;
  1409. Case UCase(sOOCommand) = &quot;AUTOCONTROLFOCUS&quot; : sDispatch = &quot;AutoControlFocus&quot;
  1410. Case UCase(sOOCommand) = &quot;AUTOFILTER&quot; : sDispatch = &quot;AutoFilter&quot;
  1411. Case UCase(sOOCommand) = &quot;AUTOPILOTADDRESSDATASOURCE&quot; : sDispatch = &quot;AutoPilotAddressDataSource&quot;
  1412. Case UCase(sOOCommand) = &quot;BASICBREAK&quot; : sDispatch = &quot;BasicBreak&quot;
  1413. Case iVBACommand = acCmdVisualBasicEditor Or UCase(sOOCommand) = &quot;BASICIDEAPPEAR&quot; : sDispatch = &quot;BasicIDEAppear&quot;
  1414. Case UCase(sOOCommand) = &quot;BASICSTOP&quot; : sDispatch = &quot;BasicStop&quot;
  1415. Case iVBACommand = acCmdBringToFront Or UCase(sOOCommand) = &quot;BRINGTOFRONT&quot; : sDispatch = &quot;BringToFront&quot;
  1416. Case UCase(sOOCommand) = &quot;CHECKBOX&quot; : sDispatch = &quot;CheckBox&quot;
  1417. Case UCase(sOOCommand) = &quot;CHOOSEMACRO&quot; : sDispatch = &quot;ChooseMacro&quot;
  1418. Case iVBACommand = acCmdClose Or UCase(sOOCommand) = &quot;CLOSEDOC&quot; : sDispatch = &quot;CloseDoc&quot;
  1419. Case UCase(sOOCommand) = &quot;CLOSEWIN&quot; : sDispatch = &quot;CloseWin&quot;
  1420. Case iVBACommand = acCmdToolbarsCustomize Or UCase(sOOCommand) = &quot;CONFIGUREDIALOG&quot; : sDispatch = &quot;ConfigureDialog&quot;
  1421. Case UCase(sOOCommand) = &quot;CONTROLPROPERTIES&quot; : sDispatch = &quot;ControlProperties&quot;
  1422. Case iVBACommand = acCmdChangeToCommandButton Or UCase(sOOCommand) = &quot;CONVERTTOBUTTON&quot; : sDispatch = &quot;ConvertToButton&quot;
  1423. Case iVBACommand = acCmdChangeToCheckBox Or UCase(sOOCommand) = &quot;CONVERTTOCHECKBOX&quot; : sDispatch = &quot;ConvertToCheckBox&quot;
  1424. Case iVBACommand = acCmdChangeToComboBox Or UCase(sOOCommand) = &quot;CONVERTTOCOMBO&quot; : sDispatch = &quot;ConvertToCombo&quot;
  1425. Case UCase(sOOCommand) = &quot;CONVERTTOCURRENCY&quot; : sDispatch = &quot;ConvertToCurrency&quot;
  1426. Case UCase(sOOCommand) = &quot;CONVERTTODATE&quot; : sDispatch = &quot;ConvertToDate&quot;
  1427. Case iVBACommand = acCmdChangeToTextBox Or UCase(sOOCommand) = &quot;CONVERTTOEDIT&quot; : sDispatch = &quot;ConvertToEdit&quot;
  1428. Case UCase(sOOCommand) = &quot;CONVERTTOFILECONTROL&quot; : sDispatch = &quot;ConvertToFileControl&quot;
  1429. Case iVBACommand = acCmdChangeToLabel Or UCase(sOOCommand) = &quot;CONVERTTOFIXED&quot; : sDispatch = &quot;ConvertToFixed&quot;
  1430. Case UCase(sOOCommand) = &quot;CONVERTTOFORMATTED&quot; : sDispatch = &quot;ConvertToFormatted&quot;
  1431. Case UCase(sOOCommand) = &quot;CONVERTTOGROUP&quot; : sDispatch = &quot;ConvertToGroup&quot;
  1432. Case UCase(sOOCommand) = &quot;CONVERTTOIMAGEBTN&quot; : sDispatch = &quot;ConvertToImageBtn&quot;
  1433. Case iVBACommand = acCmdChangeToImage Or UCase(sOOCommand) = &quot;CONVERTTOIMAGECONTROL&quot; : sDispatch = &quot;ConvertToImageControl&quot;
  1434. Case iVBACommand = acCmdChangeToListBox Or UCase(sOOCommand) = &quot;CONVERTTOLIST&quot; : sDispatch = &quot;ConvertToList&quot;
  1435. Case UCase(sOOCommand) = &quot;CONVERTTONAVIGATIONBAR&quot; : sDispatch = &quot;ConvertToNavigationBar&quot;
  1436. Case UCase(sOOCommand) = &quot;CONVERTTONUMERIC&quot; : sDispatch = &quot;ConvertToNumeric&quot;
  1437. Case UCase(sOOCommand) = &quot;CONVERTTOPATTERN&quot; : sDispatch = &quot;ConvertToPattern&quot;
  1438. Case iVBACommand = acCmdChangeToOptionButton Or UCase(sOOCommand) = &quot;CONVERTTORADIO&quot; : sDispatch = &quot;ConvertToRadio&quot;
  1439. Case UCase(sOOCommand) = &quot;CONVERTTOSCROLLBAR&quot; : sDispatch = &quot;ConvertToScrollBar&quot;
  1440. Case UCase(sOOCommand) = &quot;CONVERTTOSPINBUTTON&quot; : sDispatch = &quot;ConvertToSpinButton&quot;
  1441. Case UCase(sOOCommand) = &quot;CONVERTTOTIME&quot; : sDispatch = &quot;ConvertToTime&quot;
  1442. Case iVBACommand = acCmdCopy Or UCase(sOOCommand) = &quot;COPY&quot; : sDispatch = &quot;Copy&quot;
  1443. Case UCase(sOOCommand) = &quot;CURRENCYFIELD&quot; : sDispatch = &quot;CurrencyField&quot;
  1444. Case iVBACommand = acCmdCut Or UCase(sOOCommand) = &quot;CUT&quot; : sDispatch = &quot;Cut&quot;
  1445. Case UCase(sOOCommand) = &quot;DATEFIELD&quot; : sDispatch = &quot;DateField&quot;
  1446. Case iVBACommand = acCmdCreateRelationship Or UCase(sOOCommand) = &quot;DBADDRELATION &quot; : sDispatch = &quot;DBAddRelation &quot;
  1447. Case UCase(sOOCommand) = &quot;DBCONVERTTOVIEW &quot; : sDispatch = &quot;DBConvertToView &quot;
  1448. Case iVBACommand = acCmdDelete Or UCase(sOOCommand) = &quot;DBDELETE &quot; : sDispatch = &quot;DBDelete &quot;
  1449. Case UCase(sOOCommand) = &quot;DBDIRECTSQL &quot; : sDispatch = &quot;DBDirectSQL &quot;
  1450. Case UCase(sOOCommand) = &quot;DBDSADVANCEDSETTINGS &quot; : sDispatch = &quot;DBDSAdvancedSettings &quot;
  1451. Case UCase(sOOCommand) = &quot;DBDSCONNECTIONTYPE &quot; : sDispatch = &quot;DBDSConnectionType &quot;
  1452. Case iVBACommand = acCmdDatabaseProperties Or UCase(sOOCommand) = &quot;DBDSPROPERTIES &quot; : sDispatch = &quot;DBDSProperties &quot;
  1453. Case UCase(sOOCommand) = &quot;DBEDIT &quot; : sDispatch = &quot;DBEdit &quot;
  1454. Case iVBACommand = acCmdSQLView Or UCase(sOOCommand) = &quot;DBEDITSQLVIEW &quot; : sDispatch = &quot;DBEditSqlView &quot;
  1455. Case iVBACommand = acCmdRemove Or UCase(sOOCommand) = &quot;DBFORMDELETE &quot; : sDispatch = &quot;DBFormDelete &quot;
  1456. Case iVBACommand = acCmdDesignView Or UCase(sOOCommand) = &quot;DBFORMEDIT &quot; : sDispatch = &quot;DBFormEdit &quot;
  1457. Case iVBACommand = acCmdFormView Or UCase(sOOCommand) = &quot;DBFORMOPEN &quot; : sDispatch = &quot;DBFormOpen &quot;
  1458. Case UCase(sOOCommand) = &quot;DBFORMRENAME &quot; : sDispatch = &quot;DBFormRename &quot;
  1459. Case iVBACommand = acCmdNewObjectForm Or UCase(sOOCommand) = &quot;DBNEWFORM &quot; : sDispatch = &quot;DBNewForm &quot;
  1460. Case UCase(sOOCommand) = &quot;DBNEWFORMAUTOPILOT &quot; : sDispatch = &quot;DBNewFormAutoPilot &quot;
  1461. Case UCase(sOOCommand) = &quot;DBNEWQUERY &quot; : sDispatch = &quot;DBNewQuery &quot;
  1462. Case UCase(sOOCommand) = &quot;DBNEWQUERYAUTOPILOT &quot; : sDispatch = &quot;DBNewQueryAutoPilot &quot;
  1463. Case UCase(sOOCommand) = &quot;DBNEWQUERYSQL &quot; : sDispatch = &quot;DBNewQuerySql &quot;
  1464. Case UCase(sOOCommand) = &quot;DBNEWREPORT &quot; : sDispatch = &quot;DBNewReport &quot;
  1465. Case UCase(sOOCommand) = &quot;DBNEWREPORTAUTOPILOT &quot; : sDispatch = &quot;DBNewReportAutoPilot &quot;
  1466. Case iVBACommand = acCmdNewObjectTable Or UCase(sOOCommand) = &quot;DBNEWTABLE &quot; : sDispatch = &quot;DBNewTable &quot;
  1467. Case UCase(sOOCommand) = &quot;DBNEWTABLEAUTOPILOT &quot; : sDispatch = &quot;DBNewTableAutoPilot &quot;
  1468. Case iVBACommand = acCmdNewObjectView Or UCase(sOOCommand) = &quot;DBNEWVIEW &quot; : sDispatch = &quot;DBNewView &quot;
  1469. Case UCase(sOOCommand) = &quot;DBNEWVIEWSQL &quot; : sDispatch = &quot;DBNewViewSQL &quot;
  1470. Case iVBACommand = acCmdOpenDatabase Or UCase(sOOCommand) = &quot;DBOPEN &quot; : sDispatch = &quot;DBOpen &quot;
  1471. Case iVBACommand = acCmdRemove Or UCase(sOOCommand) = &quot;DBQUERYDELETE &quot; : sDispatch = &quot;DBQueryDelete &quot;
  1472. Case iVBACommand = acCmdDesignView Or UCase(sOOCommand) = &quot;DBQUERYEDIT &quot; : sDispatch = &quot;DBQueryEdit &quot;
  1473. Case iVBACommand = acCmdNewObjectQuery Or UCase(sOOCommand) = &quot;DBQUERYOPEN &quot; : sDispatch = &quot;DBQueryOpen &quot;
  1474. Case UCase(sOOCommand) = &quot;DBQUERYRENAME &quot; : sDispatch = &quot;DBQueryRename &quot;
  1475. Case UCase(sOOCommand) = &quot;DBREFRESHTABLES &quot; : sDispatch = &quot;DBRefreshTables &quot;
  1476. Case iVBACommand = acCmdShowAllRelationships Or UCase(sOOCommand) = &quot;DBRELATIONDESIGN &quot; : sDispatch = &quot;DBRelationDesign &quot;
  1477. Case UCase(sOOCommand) = &quot;DBRENAME &quot; : sDispatch = &quot;DBRename &quot;
  1478. Case iVBACommand = acCmdRemove Or UCase(sOOCommand) = &quot;DBREPORTDELETE &quot; : sDispatch = &quot;DBReportDelete &quot;
  1479. Case iVBACommand = acCmdDesignView Or UCase(sOOCommand) = &quot;DBREPORTEDIT &quot; : sDispatch = &quot;DBReportEdit &quot;
  1480. Case iVBACommand = acCmdNewObjectReport Or UCase(sOOCommand) = &quot;DBREPORTOPEN &quot; : sDispatch = &quot;DBReportOpen &quot;
  1481. Case UCase(sOOCommand) = &quot;DBREPORTRENAME &quot; : sDispatch = &quot;DBReportRename &quot;
  1482. Case iVBACommand = acCmdSelectAll Or UCase(sOOCommand) = &quot;DBSELECTALL &quot; : sDispatch = &quot;DBSelectAll &quot;
  1483. Case UCase(sOOCommand) = &quot;DBSHOWDOCINFOPREVIEW &quot; : sDispatch = &quot;DBShowDocInfoPreview &quot;
  1484. Case UCase(sOOCommand) = &quot;DBSHOWDOCPREVIEW &quot; : sDispatch = &quot;DBShowDocPreview &quot;
  1485. Case iVBACommand = acCmdRemoveTable Or UCase(sOOCommand) = &quot;DBTABLEDELETE &quot; : sDispatch = &quot;DBTableDelete &quot;
  1486. Case iVBACommand = acCmdDesignView Or UCase(sOOCommand) = &quot;DBTABLEEDIT &quot; : sDispatch = &quot;DBTableEdit &quot;
  1487. Case UCase(sOOCommand) = &quot;DBTABLEFILTER &quot; : sDispatch = &quot;DBTableFilter &quot;
  1488. Case iVBACommand = acCmdOpenTable Or UCase(sOOCommand) = &quot;DBTABLEOPEN &quot; : sDispatch = &quot;DBTableOpen &quot;
  1489. Case iVBACommand = acCmdRename Or UCase(sOOCommand) = &quot;DBTABLERENAME &quot; : sDispatch = &quot;DBTableRename &quot;
  1490. Case UCase(sOOCommand) = &quot;DBUSERADMIN &quot; : sDispatch = &quot;DBUserAdmin &quot;
  1491. Case UCase(sOOCommand) = &quot;DBVIEWFORMS &quot; : sDispatch = &quot;DBViewForms &quot;
  1492. Case UCase(sOOCommand) = &quot;DBVIEWQUERIES &quot; : sDispatch = &quot;DBViewQueries &quot;
  1493. Case UCase(sOOCommand) = &quot;DBVIEWREPORTS &quot; : sDispatch = &quot;DBViewReports &quot;
  1494. Case UCase(sOOCommand) = &quot;DBVIEWTABLES &quot; : sDispatch = &quot;DBViewTables &quot;
  1495. Case iVBACommand = acCmdDelete Or UCase(sOOCommand) = &quot;DELETE&quot; : sDispatch = &quot;Delete&quot;
  1496. Case iVBACommand = acCmdDeleteRecord Or UCase(sOOCommand) = &quot;DELETERECORD&quot; : sDispatch = &quot;DeleteRecord&quot;
  1497. Case UCase(sOOCommand) = &quot;DESIGNERDIALOG&quot; : sDispatch = &quot;DesignerDialog&quot;
  1498. Case UCase(sOOCommand) = &quot;EDIT&quot; : sDispatch = &quot;Edit&quot;
  1499. Case UCase(sOOCommand) = &quot;FIRSTRECORD&quot; : sDispatch = &quot;FirstRecord&quot;
  1500. Case UCase(sOOCommand) = &quot;FONTDIALOG&quot; : sDispatch = &quot;FontDialog&quot;
  1501. Case UCase(sOOCommand) = &quot;FONTHEIGHT&quot; : sDispatch = &quot;FontHeight&quot;
  1502. Case UCase(sOOCommand) = &quot;FORMATTEDFIELD&quot; : sDispatch = &quot;FormattedField&quot;
  1503. Case UCase(sOOCommand) = &quot;FORMFILTER&quot; : sDispatch = &quot;FormFilter&quot;
  1504. Case iVBACommand = acCmdApplyFilterSort Or UCase(sOOCommand) = &quot;FORMFILTERED&quot; : sDispatch = &quot;FormFiltered&quot;
  1505. Case UCase(sOOCommand) = &quot;FORMFILTEREXECUTE&quot; : sDispatch = &quot;FormFilterExecute&quot;
  1506. Case UCase(sOOCommand) = &quot;FORMFILTEREXIT&quot; : sDispatch = &quot;FormFilterExit&quot;
  1507. Case UCase(sOOCommand) = &quot;FORMFILTERNAVIGATOR&quot; : sDispatch = &quot;FormFilterNavigator&quot;
  1508. Case UCase(sOOCommand) = &quot;FORMPROPERTIES&quot; : sDispatch = &quot;FormProperties&quot;
  1509. Case UCase(sOOCommand) = &quot;FULLSCREEN&quot; : sDispatch = &quot;FullScreen&quot;
  1510. Case UCase(sOOCommand) = &quot;GALLERY&quot; : sDispatch = &quot;Gallery&quot;
  1511. Case UCase(sOOCommand) = &quot;GRID&quot; : sDispatch = &quot;Grid&quot;
  1512. Case iVBACommand = acCmdSnapToGrid Or UCase(sOOCommand) = &quot;GRIDUSE&quot; : sDispatch = &quot;GridUse&quot;
  1513. Case iVBACommand = acCmdViewGrid Or UCase(sOOCommand) = &quot;GRIDVISIBLE&quot; : sDispatch = &quot;GridVisible&quot;
  1514. Case UCase(sOOCommand) = &quot;GROUPBOX&quot; : sDispatch = &quot;GroupBox&quot;
  1515. Case UCase(sOOCommand) = &quot;HELPINDEX&quot; : sDispatch = &quot;HelpIndex&quot;
  1516. Case UCase(sOOCommand) = &quot;HELPSUPPORT&quot; : sDispatch = &quot;HelpSupport&quot;
  1517. Case iVBACommand = acCmdInsertHyperlink Or UCase(sOOCommand) = &quot;HYPERLINKDIALOG&quot; : sDispatch = &quot;HyperlinkDialog&quot;
  1518. Case UCase(sOOCommand) = &quot;IMAGEBUTTON&quot; : sDispatch = &quot;Imagebutton&quot;
  1519. Case UCase(sOOCommand) = &quot;IMAGECONTROL&quot; : sDispatch = &quot;ImageControl&quot;
  1520. Case UCase(sOOCommand) = &quot;LABEL&quot; : sDispatch = &quot;Label&quot;
  1521. Case iVBACommand = acCmdMaximumRecords Or UCase(sOOCommand) = &quot;LASTRECORD&quot; : sDispatch = &quot;LastRecord&quot;
  1522. Case UCase(sOOCommand) = &quot;LISTBOX&quot; : sDispatch = &quot;ListBox&quot;
  1523. Case UCase(sOOCommand) = &quot;MACRODIALOG&quot; : sDispatch = &quot;MacroDialog&quot;
  1524. Case UCase(sOOCommand) = &quot;MACROORGANIZER&quot; : sDispatch = &quot;MacroOrganizer&quot;
  1525. Case UCase(sOOCommand) = &quot;NAVIGATIONBAR&quot; : sDispatch = &quot;NavigationBar&quot;
  1526. Case iVBACommand = acCmdObjectBrowser Or UCase(sOOCommand) = &quot;NAVIGATOR&quot; : sDispatch = &quot;Navigator&quot;
  1527. Case UCase(sOOCommand) = &quot;NEWDOC&quot; : sDispatch = &quot;NewDoc&quot;
  1528. Case UCase(sOOCommand) = &quot;NEWRECORD&quot; : sDispatch = &quot;NewRecord&quot;
  1529. Case UCase(sOOCommand) = &quot;NEXTRECORD&quot; : sDispatch = &quot;NextRecord&quot;
  1530. Case UCase(sOOCommand) = &quot;NUMERICFIELD&quot; : sDispatch = &quot;NumericField&quot;
  1531. Case UCase(sOOCommand) = &quot;OPEN&quot; : sDispatch = &quot;Open&quot;
  1532. Case UCase(sOOCommand) = &quot;OPTIONSTREEDIALOG&quot; : sDispatch = &quot;OptionsTreeDialog&quot;
  1533. Case UCase(sOOCommand) = &quot;ORGANIZER&quot; : sDispatch = &quot;Organizer&quot;
  1534. Case UCase(sOOCommand) = &quot;PARAGRAPHDIALOG&quot; : sDispatch = &quot;ParagraphDialog&quot;
  1535. Case iVBACommand = acCmdPaste Or UCase(sOOCommand) = &quot;PASTE&quot; : sDispatch = &quot;Paste&quot;
  1536. Case iVBACommand = acCmdPasteSpecial Or UCase(sOOCommand) = &quot;PASTESPECIAL &quot; : sDispatch = &quot;PasteSpecial &quot;
  1537. Case UCase(sOOCommand) = &quot;PATTERNFIELD&quot; : sDispatch = &quot;PatternField&quot;
  1538. Case UCase(sOOCommand) = &quot;PREVRECORD&quot; : sDispatch = &quot;PrevRecord&quot;
  1539. Case iVBACommand = acCmdPrint Or UCase(sOOCommand) = &quot;PRINT&quot; : sDispatch = &quot;Print&quot;
  1540. Case UCase(sOOCommand) = &quot;PRINTDEFAULT&quot; : sDispatch = &quot;PrintDefault&quot;
  1541. Case UCase(sOOCommand) = &quot;PRINTERSETUP&quot; : sDispatch = &quot;PrinterSetup&quot;
  1542. Case iVBACommand = acCmdPrintPreview Or UCase(sOOCommand) = &quot;PRINTPREVIEW&quot; : sDispatch = &quot;PrintPreview&quot;
  1543. Case UCase(sOOCommand) = &quot;PUSHBUTTON&quot; : sDispatch = &quot;Pushbutton&quot;
  1544. Case UCase(sOOCommand) = &quot;QUIT&quot; : sDispatch = &quot;Quit&quot;
  1545. Case UCase(sOOCommand) = &quot;RADIOBUTTON&quot; : sDispatch = &quot;RadioButton&quot;
  1546. Case iVBACommand = acCmdSaveRecord Or UCase(sOOCommand) = &quot;RECSAVE&quot; : sDispatch = &quot;RecSave&quot;
  1547. Case iVBACommand = acCmdFind Or UCase(sOOCommand) = &quot;RECSEARCH&quot; : sDispatch = &quot;RecSearch&quot;
  1548. Case iVBACommand = acCmdUndo Or UCase(sOOCommand) = &quot;RECUNDO&quot; : sDispatch = &quot;RecUndo&quot;
  1549. Case iVBACommand = acCmdRefresh Or UCase(sOOCommand) = &quot;REFRESH&quot; : sDispatch = &quot;Refresh&quot;
  1550. Case UCase(sOOCommand) = &quot;RELOAD&quot; : sDispatch = &quot;Reload&quot;
  1551. Case iVBACommand = acCmdRemoveFilterSort Or UCase(sOOCommand) = &quot;REMOVEFILTERSORT&quot; : sDispatch = &quot;RemoveFilterSort&quot;
  1552. Case iVBACommand = acCmdRunMacro Or UCase(sOOCommand) = &quot;RUNMACRO&quot; : sDispatch = &quot;RunMacro&quot;
  1553. Case iVBACommand = acCmdSave Or UCase(sOOCommand) = &quot;SAVE&quot; : sDispatch = &quot;Save&quot;
  1554. Case UCase(sOOCommand) = &quot;SAVEALL&quot; : sDispatch = &quot;SaveAll&quot;
  1555. Case iVBACommand = acCmdSaveAs Or UCase(sOOCommand) = &quot;SAVEAS&quot; : sDispatch = &quot;SaveAs&quot;
  1556. Case UCase(sOOCommand) = &quot;SAVEBASICAS&quot; : sDispatch = &quot;SaveBasicAs&quot;
  1557. Case UCase(sOOCommand) = &quot;SCRIPTORGANIZER&quot; : sDispatch = &quot;ScriptOrganizer&quot;
  1558. Case UCase(sOOCommand) = &quot;SCROLLBAR&quot; : sDispatch = &quot;ScrollBar&quot;
  1559. Case iVBACommand = acCmdFind Or UCase(sOOCommand) = &quot;SEARCHDIALOG&quot; : sDispatch = &quot;SearchDialog&quot;
  1560. Case iVBACommand = acCmdSelectAll Or UCase(sOOCommand) = &quot;SELECTALL&quot; : sDispatch = &quot;SelectAll&quot;
  1561. Case iVBACommand = acCmdSelectAllRecords Or UCase(sOOCommand) = &quot;SELECTALL&quot; : sDispatch = &quot;SelectAll&quot;
  1562. Case iVBACommand = acCmdSendToBack Or UCase(sOOCommand) = &quot;SENDTOBACK&quot; : sDispatch = &quot;SendToBack&quot;
  1563. Case UCase(sOOCommand) = &quot;SHOWFMEXPLORER&quot; : sDispatch = &quot;ShowFmExplorer&quot;
  1564. Case UCase(sOOCommand) = &quot;SIDEBAR&quot; : sDispatch = &quot;Sidebar&quot;
  1565. Case iVBACommand = acCmdSortDescending Or UCase(sOOCommand) = &quot;SORTDOWN&quot; : sDispatch = &quot;SortDown&quot;
  1566. Case iVBACommand = acCmdSortAscending Or UCase(sOOCommand) = &quot;SORTUP&quot; : sDispatch = &quot;Sortup&quot;
  1567. Case UCase(sOOCommand) = &quot;SPINBUTTON&quot; : sDispatch = &quot;SpinButton&quot;
  1568. Case UCase(sOOCommand) = &quot;STATUSBARVISIBLE&quot; : sDispatch = &quot;StatusBarVisible&quot;
  1569. Case UCase(sOOCommand) = &quot;SWITCHCONTROLDESIGNMODE&quot; : sDispatch = &quot;SwitchControlDesignMode&quot;
  1570. Case iVBACommand = acCmdTabOrder Or UCase(sOOCommand) = &quot;TABDIALOG&quot; : sDispatch = &quot;TabDialog&quot;
  1571. Case UCase(sOOCommand) = &quot;USEWIZARDS&quot; : sDispatch = &quot;UseWizards&quot;
  1572. Case UCase(sOOCommand) = &quot;VERSIONDIALOG&quot; : sDispatch = &quot;VersionDialog&quot;
  1573. Case UCase(sOOCommand) = &quot;VIEWDATASOURCEBROWSER&quot; : sDispatch = &quot;ViewDataSourceBrowser&quot;
  1574. Case iVBACommand = acCmdDatasheetView Or UCase(sOOCommand) = &quot;VIEWFORMASGRID&quot; : sDispatch = &quot;ViewFormAsGrid&quot;
  1575. Case iVBACommand = acCmdZoomSelection Or UCase(sOOCommand) = &quot;ZOOM&quot; : sDispatch = &quot;Zoom&quot;
  1576. Case Else
  1577. If iVBACommand &gt;= 0 Then Goto Exit_Function
  1578. sDispatch = pvCommand
  1579. End Select
  1580. If pbReturnCommand Then RunCommand = cstUnoPrefix &amp; sDispatch Else Call _DispatchCommand(cstUnoPrefix &amp; sDispatch)
  1581. Exit_Function:
  1582. Utils._ResetCalledSub(cstThisSub)
  1583. Exit Function
  1584. Error_Function:
  1585. TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
  1586. GoTo Exit_Function
  1587. End Function &apos; RunCommand V0.7.0
  1588. REM -----------------------------------------------------------------------------------------------------------------------
  1589. Public Function RunSQL(Optional ByVal pvSQL As Variant _
  1590. , Optional ByVal pvOption As Variant _
  1591. ) As Boolean
  1592. &apos; Return True if the execution of the SQL statement was successful
  1593. &apos; SQL must contain an ACTION query
  1594. If _ErrorHandler() Then On Local Error Goto Error_Function
  1595. Utils._SetCalledSub(&quot;RunSQL&quot;)
  1596. RunSQL = False
  1597. If IsMissing(pvSQL) Then Call _TraceArguments()
  1598. If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function
  1599. Const cstNull = -1
  1600. If IsMissing(pvOption) Then
  1601. pvOption = cstNull
  1602. Else
  1603. If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
  1604. End If
  1605. RunSQL = Application._CurrentDb.RunSQL(pvSQL, pvOption)
  1606. Exit_Function:
  1607. Utils._ResetCalledSub(&quot;RunSQL&quot;)
  1608. Exit Function
  1609. Error_Function:
  1610. TraceError(TRACEABORT, Err, &quot;RunSQL&quot;, Erl)
  1611. GoTo Exit_Function
  1612. End Function &apos; RunSQL V1.1.0
  1613. REM -----------------------------------------------------------------------------------------------------------------------
  1614. Public Function SelectObject( ByVal Optional pvObjectType As Variant _
  1615. , ByVal Optional pvObjectName As Variant _
  1616. , ByVal Optional pvInDatabaseWindow As Variant _
  1617. ) As Boolean
  1618. If _ErrorHandler() Then On Local Error Goto Error_Function
  1619. Const cstThisSub = &quot;SelectObject&quot;
  1620. Utils._SetCalledSub(cstThisSub)
  1621. If IsMissing(pvObjectType) Then Call _TraceArguments()
  1622. If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _
  1623. Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow, acDocument) _
  1624. ) Then Goto Exit_Function
  1625. If IsMissing(pvObjectName) Then
  1626. Select Case pvObjectType
  1627. Case acForm, acQuery, acTable, acReport, acDocument : Call _TraceArguments()
  1628. Case Else
  1629. End Select
  1630. pvObjectName = &quot;&quot;
  1631. Else
  1632. If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
  1633. End If
  1634. If Not IsMissing(pvInDatabaseWindow) Then
  1635. If Not Utils._CheckArgument(pvInDatabaseWindow, 3, vbBoolean, False) Then Goto Exit_Function
  1636. End If
  1637. Dim oWindow As Object
  1638. Set oWindow = _SelectWindow(pvObjectType, pvObjectName)
  1639. If IsNull(oWindow.Frame) Then Goto Error_NotFound
  1640. With oWindow.Frame.ContainerWindow
  1641. If .isVisible() = False Then .setVisible(True)
  1642. .IsMinimized = False
  1643. .setFocus()
  1644. .setEnable(True) &apos; Added to try to bypass desynchro issue in Linux
  1645. .toFront() &apos; Added to force window change in Linux
  1646. End With
  1647. Exit_Function:
  1648. Utils._ResetCalledSub(cstThisSub)
  1649. Exit Function
  1650. Error_NotFound:
  1651. TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;OBJECT&quot;), pvObjectName))
  1652. Goto Exit_Function
  1653. Error_Function:
  1654. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  1655. GoTo Exit_Function
  1656. End Function &apos; SelectObject V1.1.0
  1657. REM -----------------------------------------------------------------------------------------------------------------------
  1658. Public Function SendObject(ByVal Optional pvObjectType As Variant _
  1659. , ByVal Optional pvObjectName As Variant _
  1660. , ByVal Optional pvOutputFormat As Variant _
  1661. , ByVal Optional pvTo As Variant _
  1662. , ByVal Optional pvCc As Variant _
  1663. , ByVal Optional pvBcc As Variant _
  1664. , ByVal Optional pvSubject As Variant _
  1665. , ByVal Optional pvMessageText As Variant _
  1666. , ByVal Optional pvEditMessage As Variant _
  1667. , ByVal Optional pvTemplateFile As Variant _
  1668. ) As Boolean
  1669. &apos;Supported: acFormatPDF, acFormatODT, acFormatDOC, acFormatHTML for forms
  1670. &apos;To be prepared: acFormatCSV and acFormatODS for tables/queries ?
  1671. If _ErrorHandler() Then On Local Error Goto Error_Function
  1672. Utils._SetCalledSub(&quot;SendObject&quot;)
  1673. SendObject = False
  1674. If IsMissing(pvObjectType) Then pvObjectType = acSendNoObject
  1675. If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acSendNoObject, acSendForm)) Then Goto Exit_Function
  1676. If IsMissing(pvObjectName) Then pvObjectName = &quot;&quot;
  1677. If Not Utils._CheckArgument(pvObjectName, 2,vbString) Then Goto Exit_Function
  1678. If IsMissing(pvOutputFormat) Then pvOutputFormat = &quot;&quot;
  1679. If Not Utils._CheckArgument(pvOutputFormat, 3, vbString) Then Goto Exit_Function
  1680. If pvOutputFormat &lt;&gt; &quot;&quot; Then
  1681. If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _
  1682. UCase(acFormatPDF), UCase(acFormatODT), UCase(acFormatDOC), UCase(acFormatHTML) _
  1683. , &quot;PDF&quot;, &quot;ODT&quot;, &quot;DOC&quot;, &quot;HTML&quot;, &quot;&quot; _
  1684. )) Then Goto Exit_Function &apos; A 2nd time to allow case unsensitivity
  1685. End If
  1686. If IsMissing(pvTo) Then pvTo = &quot;&quot;
  1687. If Not Utils._CheckArgument(pvTo, 4, vbString) Then Goto Exit_Function
  1688. If IsMissing(pvCc) Then pvCc = &quot;&quot;
  1689. If Not Utils._CheckArgument(pvCc, 5, vbString) Then Goto Exit_Function
  1690. If IsMissing(pvBcc) Then pvBcc = &quot;&quot;
  1691. If Not Utils._CheckArgument(pvBcc, 6, vbString) Then Goto Exit_Function
  1692. If IsMissing(pvSubject) Then pvSubject = &quot;&quot;
  1693. If Not Utils._CheckArgument(pvSubject, 7, vbString) Then Goto Exit_Function
  1694. If IsMissing(pvMessageText) Then pvMessageText = &quot;&quot;
  1695. If Not Utils._CheckArgument(pvMessageText, 8, vbString) Then Goto Exit_Function
  1696. If IsMissing(pvEditMessage) Then pvEditMessage = True
  1697. If Not Utils._CheckArgument(pvEditMessage, 9, vbBoolean) Then Goto Exit_Function
  1698. If IsMissing(pvTemplateFile) Then pvTemplateFile = &quot;&quot;
  1699. If Not Utils._CheckArgument(pvTemplateFile, 10, vbString, &quot;&quot;) Then Goto Exit_Function
  1700. Dim vTo() As Variant, vCc() As Variant, vBcc() As Variant, oWindow As Object
  1701. Dim sDirectory As String, sOutputFile As String, sSuffix As String, sOutputFormat As String
  1702. Const cstSemiColon = &quot;;&quot;
  1703. If pvTo &lt;&gt; &quot;&quot; Then vTo() = Split(pvTo, cstSemiColon) Else vTo() = Array()
  1704. If pvCc &lt;&gt; &quot;&quot; Then vCc() = Split(pvCc, cstSemiColon) Else vCc() = Array()
  1705. If pvBcc &lt;&gt; &quot;&quot; Then vBcc() = Split(pvBcc, cstSemiColon) Else vBcc() = Array()
  1706. Select Case True
  1707. Case pvObjectType = acSendNoObject And pvObjectName = &quot;&quot;
  1708. SendObject = _SendWithoutAttachment(vTo, vCc, vBcc, pvSubject, pvMessageText)
  1709. Case Else
  1710. If pvObjectType = acSendNoObject And pvObjectName &lt;&gt; &quot;&quot; Then
  1711. If Not FileExists(pvObjectName) Then Goto Error_File
  1712. sOutputFile = pvObjectName
  1713. Else &apos; OutputFile has to be created
  1714. If pvObjectType &lt;&gt; acSendNoObject And pvObjectName = &quot;&quot; Then
  1715. oWindow = _SelectWindow()
  1716. If oWindow.WindowType &lt;&gt; acSendForm Then Goto Error_Action
  1717. pvObjectType = acSendForm
  1718. pvObjectName = oWindow._Name
  1719. End If
  1720. sDirectory = Utils._getTempDirectoryURL()
  1721. If Right(sDirectory, 1) &lt;&gt; &quot;/&quot; Then sDirectory = sDirectory &amp; &quot;/&quot;
  1722. If pvOutputFormat = &quot;&quot; Then
  1723. sOutputFormat = _PromptFormat(Array(&quot;PDF&quot;, &quot;ODT&quot;, &quot;DOC&quot;, &quot;HTML&quot;)) &apos; Prompt user for format
  1724. If sOutputFormat = &quot;&quot; Then Goto Exit_Function
  1725. Else
  1726. sOutputFormat = UCase(pvOutputFormat)
  1727. End If
  1728. Select Case sOutputFormat
  1729. Case UCase(acFormatPDF), &quot;PDF&quot; : sSuffix = &quot;pdf&quot;
  1730. Case UCase(acFormatDOC), &quot;DOC&quot; : sSuffix = &quot;doc&quot;
  1731. Case UCase(acFormatODT), &quot;ODT&quot; : sSuffix = &quot;odt&quot;
  1732. Case UCase(acFormatHTML), &quot;HTML&quot; : sSuffix = &quot;html&quot;
  1733. End Select
  1734. sOutputFile = sDirectory &amp; pvObjectName &amp; &quot;.&quot; &amp; sSuffix
  1735. If Not OutputTo(pvObjectType, pvObjectName, sOutputFormat, sOutputFile, False) Then Goto Exit_Function
  1736. End If
  1737. SendObject = _SendWithAttachment(vTo, vCc, vBcc, pvSubject, Array(sOutputFile), pvMessageText, pvEditMessage)
  1738. End Select
  1739. Exit_Function:
  1740. Utils._ResetCalledSub(&quot;SendObject&quot;)
  1741. Exit Function
  1742. Error_NotFound:
  1743. TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;OBJECT&quot;), pvObjectName))
  1744. Goto Exit_Function
  1745. Error_Function:
  1746. TraceError(TRACEABORT, Err, &quot;SendObject&quot;, Erl)
  1747. GoTo Exit_Function
  1748. Error_Action:
  1749. TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0)
  1750. Goto Exit_Function
  1751. Error_File:
  1752. TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , pvObjectName)
  1753. Goto Exit_Function
  1754. End Function &apos; SendObject V0.8.5
  1755. REM -----------------------------------------------------------------------------------------------------------------------
  1756. Public Function SetHiddenAttribute(ByVal Optional pvObjectType As Variant _
  1757. , ByVal Optional pvObjectName As Variant _
  1758. , ByVal Optional pvHidden As Variant _
  1759. ) As Boolean
  1760. If _ErrorHandler() Then On Local Error Goto Error_Function
  1761. SetHiddenAttribute = False
  1762. Const cstThisSub = &quot;SetHiddenAttribute&quot;
  1763. Utils._SetCalledSub(cstThisSub)
  1764. If IsMissing(pvObjectType) Then Call _TraceArguments()
  1765. If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _
  1766. Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow), acDocument _
  1767. ) Then Goto Exit_Function
  1768. If IsMissing(pvObjectName) Then
  1769. Select Case pvObjectType
  1770. Case acForm, acQuery, acTable, acReport, acDocument : Call _TraceArguments()
  1771. Case Else
  1772. End Select
  1773. pvObjectName = &quot;&quot;
  1774. Else
  1775. If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
  1776. End If
  1777. If IsMissing(pvHidden) Then
  1778. pvHidden = True
  1779. Else
  1780. If Not Utils._CheckArgument(pvHidden, 3, vbBoolean) Then Goto Exit_Function
  1781. End If
  1782. Dim oWindow As Object
  1783. Set oWindow = _SelectWindow(pvObjectType, pvObjectName)
  1784. If IsNull(oWindow.Frame) Then Goto Error_NotFound
  1785. oWindow.Frame.ContainerWindow.setVisible(Not pvHidden)
  1786. SetHiddenAttribute = True
  1787. Exit_Function:
  1788. Utils._ResetCalledSub(cstThisSub)
  1789. Exit Function
  1790. Error_NotFound:
  1791. TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;OBJECT&quot;), pvObjectName))
  1792. Goto Exit_Function
  1793. Error_Function:
  1794. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  1795. GoTo Exit_Function
  1796. End Function &apos; SetHiddenAttribute V1.1.0
  1797. REM -----------------------------------------------------------------------------------------------------------------------
  1798. Public Function SetOrderBy( _
  1799. ByVal Optional pvOrder As Variant _
  1800. , ByVal Optional pvControlName As Variant _
  1801. ) As Boolean
  1802. &apos; Sort ann open table, query, form or subform (if pvControlName present)
  1803. If _ErrorHandler() Then On Local Error Goto Error_Function
  1804. Const cstThisSub = &quot;SetOrderBy&quot;
  1805. Utils._SetCalledSub(cstThisSub)
  1806. SetOrderBy = False
  1807. If IsMissing(pvOrder) Then pvOrder = &quot;&quot;
  1808. If Not Utils._CheckArgument(pvOrder, 1, vbString) Then Goto Exit_Function
  1809. If IsMissing(pvControlName) Then pvControlName = &quot;&quot;
  1810. If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function
  1811. Dim sOrder As String, oWindow As Object, oDatabase As Object, oTarget As Object
  1812. Set oDatabase = Application._CurrentDb()
  1813. If oDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
  1814. sOrder = oDatabase._ReplaceSquareBrackets(pvOrder)
  1815. Set oWindow = _SelectWindow()
  1816. With oWindow
  1817. Select Case .WindowType
  1818. Case acForm
  1819. Set oTarget = _DatabaseForm(._Name, pvControlName)
  1820. Case acQuery, acTable
  1821. If pvControlName &lt;&gt; &quot;&quot; Then Goto Exit_Function
  1822. If IsNull(.Frame.Controller.FormOperations) Then Goto Error_NotApplicable
  1823. &apos; FormOperations returns &lt;Null&gt; in OpenOffice
  1824. Set oTarget = .Frame.Controller.FormOperations.Cursor
  1825. Case Else &apos; Ignore action
  1826. Goto Exit_Function
  1827. End Select
  1828. End With
  1829. With oTarget
  1830. .Order = sOrder
  1831. .reload()
  1832. End With
  1833. SetOrderBy = True
  1834. Exit_Function:
  1835. Utils._ResetCalledSub(cstThisSub)
  1836. Exit Function
  1837. Error_NotApplicable:
  1838. TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
  1839. Goto Exit_Function
  1840. Error_Function:
  1841. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  1842. GoTo Exit_Function
  1843. End Function &apos; SetOrderBy V1.2.0
  1844. REM -----------------------------------------------------------------------------------------------------------------------
  1845. Public Function ShowAllrecords() As Boolean
  1846. &apos; Removes any existing filter that exists on the current table, query or form
  1847. If _ErrorHandler() Then On Local Error Goto Error_Function
  1848. Const cstThisSub = &quot;ShowAllRecords&quot;
  1849. Utils._SetCalledSub(cstThisSub)
  1850. ShowAllRecords = False
  1851. Dim oWindow As Object, oDatabase As Object
  1852. Set oDatabase = Application._CurrentDb()
  1853. If oDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
  1854. Set oWindow = _SelectWindow()
  1855. Select Case oWindow.WindowType
  1856. Case acForm, acQuery, acTable
  1857. RunCommand(acCmdRemoveFilterSort)
  1858. ShowAllrecords = True
  1859. Case Else &apos; Ignore action
  1860. End Select
  1861. Exit_Function:
  1862. Utils._ResetCalledSub(cstThisSub)
  1863. Exit Function
  1864. Error_NotApplicable:
  1865. TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub)
  1866. Goto Exit_Function
  1867. Error_Function:
  1868. TraceError(TRACEABORT, Err, cstThisSub, Erl)
  1869. GoTo Exit_Function
  1870. End Function &apos; ShowAllrecords V1.1.0
  1871. REM -----------------------------------------------------------------------------------------------------------------------
  1872. REM --- PRIVATE FUNCTIONS ---
  1873. REM -----------------------------------------------------------------------------------------------------------------------
  1874. Private Function _CheckColumnType(pvFindWhat As Variant, vDataField As Variant) As Boolean
  1875. &apos; Return true if both arguments of the same type
  1876. &apos; vDataField is a ResultSet column
  1877. Dim bFound As Boolean
  1878. bFound = False
  1879. With com.sun.star.sdbc.DataType
  1880. Select Case vDataField.Type
  1881. Case .DATE, .TIME, .TIMESTAMP
  1882. If VarType(pvFindWhat) = vbDate Then bFound = True
  1883. Case .TINYINT, .SMALLINT, .INTEGER, .BIGINT, .FLOAT, .REAL, .DOUBLE, .NUMERIC, .DECIMAL
  1884. If Utils._InList(VarType(pvFindWhat), Utils._AddNumeric()) Then bFound = True
  1885. Case .CHAR, .VARCHAR, .LONGVARCHAR
  1886. If VarType(pvFindWhat) = vbString Then bFound = True
  1887. Case Else
  1888. End Select
  1889. End With
  1890. _CheckColumnType = bFound
  1891. End Function &apos; _CheckColumnType V0.9.1
  1892. REM -----------------------------------------------------------------------------------------------------------------------
  1893. Sub _ConvertDataDescriptor( ByRef poSource As Object _
  1894. , ByVal piSourceRDBMS As Integer _
  1895. , ByRef poTarget As Object _
  1896. , ByRef poDatabase As Object _
  1897. , ByVal Optional pbKey As Boolean _
  1898. )
  1899. &apos; Convert source column descriptor to target descriptor
  1900. &apos; If RDMSs identical, simply move property by property
  1901. &apos; Otherwise
  1902. &apos; - Use Type conversion tables (cfr. DataTypes By RDBMS.ods case study)
  1903. &apos; - Select among synonyms the entry with the lowest Precision at least &gt;= source Precision
  1904. &apos; - Derive TypeName and Precision values
  1905. Dim vTypesReference() As Variant, vTypes() As Variant, vTypeNames() As Variant
  1906. Dim i As Integer, iType As Integer, iTypeAlias As Integer
  1907. Dim iNbTypes As Integer, iBestFit As Integer, lFitPrecision As Long, lPrecision As Long
  1908. On Local Error Goto Error_Sub
  1909. If IsMissing(pbKey) Then pbKey = False
  1910. poTarget.Name = poSource.Name
  1911. poTarget.Description = poSource.Description
  1912. If Not pbKey Then
  1913. poTarget.ControlDefault = poSource.ControlDefault
  1914. poTarget.FormatKey = poSource.FormatKey
  1915. poTarget.HelpText = poSource.HelpText
  1916. poTarget.Hidden = poSource.Hidden
  1917. End If
  1918. poTarget.IsCurrency = poSource.IsCurrency
  1919. poTarget.IsNullable = poSource.IsNullable
  1920. poTarget.Scale = poSource.Scale
  1921. If piSourceRDBMS = poDatabase._RDBMS Or poDatabase._RDBMS = DBMS_UNKNOWN Then
  1922. poTarget.Type = poSource.Type
  1923. poTarget.Precision = poSource.Precision
  1924. poTarget.TypeName = poSource.TypeName
  1925. Goto Exit_Sub
  1926. End If
  1927. &apos; Search DataType compatibility
  1928. With poDatabase
  1929. &apos; Find source datatype entry in Reference array
  1930. iType = -1
  1931. For i = 0 To UBound(._ColumnTypesReference)
  1932. If ._ColumnTypesReference(i) = poSource.Type Then
  1933. iType = i
  1934. Exit For
  1935. End If
  1936. Next i
  1937. If iType = -1 Then Goto Error_Compatibility
  1938. iTypeAlias = ._ColumnTypesAlias(iType)
  1939. &apos; Find best choice for the datatype of the target column
  1940. iNbTypes = UBound(._ColumnTypes)
  1941. iBestFit = -1
  1942. lFitPrecision = -2 &apos; Some POSTGRES datatypes have a precision of -1
  1943. For i = 0 To iNbTypes
  1944. If ._ColumnTypes(i) = iTypeAlias Then &apos; Minimal fit = correct datatype
  1945. lPrecision = ._ColumnPrecisions(i)
  1946. If iBestFit = -1 _
  1947. Or (iBestFit &gt; -1 And poSource.Precision &gt; 0 And lPrecision &gt;= poSource.Precision And lPrecision &lt; lFitPrecision) _
  1948. Or (iBestFit &gt; -1 And poSource.Precision = 0 And lPrecision &gt; lFitPrecision) Then &apos; First fit or better fit
  1949. iBestFit = i
  1950. lFitPrecision = lPrecision
  1951. End If
  1952. End If
  1953. Next i
  1954. If iBestFit = -1 Then Goto Error_Compatibility
  1955. poTarget.Type = iTypeAlias
  1956. poTarget.Precision = lFitPrecision
  1957. poTarget.TypeName = ._ColumnTypeNames(iBestFit)
  1958. End With
  1959. Exit_Sub:
  1960. Exit Sub
  1961. Error_Compatibility:
  1962. TraceError(TRACEFATAL, ERRCOMPATIBILITY, Utils._CalledSub(), 0, 1, poSource.Name)
  1963. Goto Exit_Sub
  1964. Error_Sub:
  1965. TraceError(TRACEABORT, Err, &quot;_ConvertDataDescriptor&quot;, Erl)
  1966. Goto Exit_Sub
  1967. End Sub &apos; ConvertDataDescriptor V1.6.0
  1968. REM -----------------------------------------------------------------------------------------------------------------------
  1969. Private Function _DatabaseForm(psForm As String, psControl As String)
  1970. &apos;Return DatabaseForm element of Form object (based on psForm which is known as a real form name)
  1971. &apos;or of SubForm object (based on psControl which is checked for being a subform)
  1972. Dim oForm As Object, oControl As Object, sControls() As String, iControlCount As Integer
  1973. Dim bFound As Boolean, i As Integer, sName As String
  1974. Set oForm = Application.Forms(psForm)
  1975. If psControl &lt;&gt; &quot;&quot; Then &apos; Search subform
  1976. With oForm.DatabaseForm
  1977. iControlCount = .getCount()
  1978. bFound = False
  1979. If iControlCount &gt; 0 Then
  1980. sControls() = .getElementNames()
  1981. sName = UCase(Utils._Trim(psControl))
  1982. For i = 0 To iControlCount - 1
  1983. If UCase(sControls(i)) = sName Then
  1984. bFound = True
  1985. Exit For
  1986. End If
  1987. Next i
  1988. End If
  1989. End With
  1990. If bFound Then sName = sControls(i) Else Goto Trace_NotFound
  1991. Set oControl = oForm.Controls(sName)
  1992. If oControl._SubType &lt;&gt; CTLSUBFORM Then Goto Trace_SubFormNotFound
  1993. Set _DatabaseForm = oControl.Form.DatabaseForm
  1994. Else
  1995. Set _DatabaseForm = oForm.DatabaseForm
  1996. End If
  1997. Exit_Function:
  1998. Exit Function
  1999. Trace_NotFound:
  2000. TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(psControl, psForm))
  2001. Goto Exit_Function
  2002. Trace_SubFormNotFound:
  2003. TraceError(TRACEFATAL, ERRSUBFORMNOTFOUND, Utils._CalledSub(), 0, , Array(psControl, psForm))
  2004. Goto Exit_Function
  2005. End Function &apos; _DatabaseForm V1.2.0
  2006. REM -----------------------------------------------------------------------------------------------------------------------
  2007. Private Sub _DispatchCommand(ByVal psCommand As String)
  2008. &apos; Execute command given as argument - &quot;.uno:&quot; is presumed already present
  2009. Dim oDocument As Object, oDispatcher As Object, oArgs() As new com.sun.star.beans.PropertyValue, sTargetFrameName As String
  2010. Dim oResult As Variant
  2011. Dim sCommand As String
  2012. Set oDocument = _SelectWindow().Frame
  2013. Set oDispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
  2014. sTargetFrameName = &quot;&quot;
  2015. oResult = oDispatcher.executeDispatch(oDocument, psCommand, sTargetFrameName, 0, oArgs())
  2016. End Sub &apos; _DispatchCommand V1.3.0
  2017. REM -----------------------------------------------------------------------------------------------------------------------
  2018. Public Function _getUpperShortcut(ByVal psShortcut As String, ByVal psLastComponent As String) As String
  2019. &apos; Return &quot;Forms!myForm&quot; from &quot;Forms!myForm!datField&quot; and &quot;datField&quot;
  2020. If Len(psShortcut) &gt; Len(psLastComponent) Then
  2021. _getUpperShortcut = Split(psShortcut, &quot;!&quot; &amp; Utils._Surround(psLastComponent))(0)
  2022. Else
  2023. _getUpperShortcut = psShortcut
  2024. End If
  2025. End Function &apos; _getUpperShortcut
  2026. REM -----------------------------------------------------------------------------------------------------------------------
  2027. Private Function _OpenObject(ByVal psObjectType As String _
  2028. , ByVal pvObjectName As Variant _
  2029. , ByVal pvView As Variant _
  2030. , ByVal pvDataMode As Variant _
  2031. ) As Boolean
  2032. If _ErrorHandler() Then On Local Error Goto Error_Function
  2033. _OpenObject = False
  2034. If Not (Utils._CheckArgument(pvObjectName, 1, vbString) _
  2035. And Utils._CheckArgument(pvView, 2, Utils._AddNumeric(), Array(acViewNormal, acViewPreview, acViewDesign)) _
  2036. And Utils._CheckArgument(pvDataMode, 3, Utils._AddNumeric(), Array(acEdit)) _
  2037. ) Then Goto Exit_Function
  2038. Dim oDatabase As Object
  2039. Set oDatabase = Application._CurrentDb()
  2040. If oDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
  2041. Dim sObjects() As String, sObjectName As String, oController As Object, oObject As Object
  2042. Dim i As Integer, bFound As Boolean, lComponent As Long, oQuery As Object
  2043. &apos; Check existence of object and find its exact (case-sensitive) name
  2044. Select Case psObjectType
  2045. Case &quot;Table&quot;
  2046. sObjects = oDatabase.Connection.getTables.ElementNames()
  2047. lComponent = com.sun.star.sdb.application.DatabaseObject.TABLE
  2048. Case &quot;Query&quot;
  2049. sObjects = oDatabase.Connection.getQueries.ElementNames()
  2050. lComponent = com.sun.star.sdb.application.DatabaseObject.QUERY
  2051. Case &quot;Report&quot;
  2052. sObjects = oDatabase.Document.getReportDocuments.ElementNames()
  2053. lComponent = com.sun.star.sdb.application.DatabaseObject.REPORT
  2054. End Select
  2055. bFound = False
  2056. For i = 0 To UBound(sObjects)
  2057. If UCase(pvObjectName) = UCase(sObjects(i)) Then
  2058. sObjectName = sObjects(i)
  2059. bFound = True
  2060. Exit For
  2061. End If
  2062. Next i
  2063. If Not bFound Then Goto Trace_NotFound
  2064. If psObjectType = &quot;Query&quot; Then &apos; Processing for action query
  2065. Set oQuery = Application._CurrentDb().QueryDefs(pvObjectName)
  2066. If oQuery.pType &lt;&gt; dbQSelect Then
  2067. _OpenObject = oQuery.Execute()
  2068. GoTo Exit_Function
  2069. End If
  2070. End If
  2071. Set oController = oDatabase.Document.CurrentController
  2072. Set oObject = oController.loadComponent(lComponent, sObjectName, ( pvView = acViewDesign ))
  2073. _OpenObject = True
  2074. Exit_Function:
  2075. Set oObject = Nothing
  2076. Set oQuery = Nothing
  2077. Set oController = Nothing
  2078. Exit Function
  2079. Error_Function:
  2080. TraceError(TRACEABORT, Err, &quot;OpenObject&quot;, Erl)
  2081. GoTo Exit_Function
  2082. Trace_Error:
  2083. TraceError(TRACEFATAL, ERROPENOBJECT, Utils._CalledSub(), 0, , Array(_GetLabel(psObjectType), pvObjectName))
  2084. Goto Exit_Function
  2085. Error_NotApplicable:
  2086. TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1)
  2087. Goto Exit_Function
  2088. Trace_NotFound:
  2089. TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(psObjectType), pvObjectName))
  2090. Goto Exit_Function
  2091. End Function &apos; _OpenObject V0.8.9
  2092. REM -----------------------------------------------------------------------------------------------------------------------
  2093. Private Function _PromptFormat(ByVal pvList As Variant) As String
  2094. &apos; Return user selection in Format dialog
  2095. Dim oDialog As Object, iOKCancel As Integer, oControl As Object
  2096. Set oDialog = CreateUnoDialog(Utils._GetDialogLib().dlgFormat)
  2097. oDialog.Title = _GetLabel(&quot;DLGFORMAT_TITLE&quot;)
  2098. Set oControl = oDialog.Model.getByName(&quot;lblFormat&quot;)
  2099. oControl.Label = _GetLabel(&quot;DLGFORMAT_LBLFORMAT_LABEL&quot;)
  2100. oControl.HelpText = _GetLabel(&quot;DLGFORMAT_LBLFORMAT_HELP&quot;)
  2101. Set oControl = oDialog.Model.getByName(&quot;cboFormat&quot;)
  2102. oControl.HelpText = _GetLabel(&quot;DLGFORMAT_LBLFORMAT_HELP&quot;)
  2103. Set oControl = oDialog.Model.getByName(&quot;cmdOK&quot;)
  2104. oControl.Label = _GetLabel(&quot;DLGFORMAT_CMDOK_LABEL&quot;)
  2105. oControl.HelpText = _GetLabel(&quot;DLGFORMAT_CMDOK_HELP&quot;)
  2106. Set oControl = oDialog.Model.getByName(&quot;cmdCancel&quot;)
  2107. oControl.Label = _GetLabel(&quot;DLGFORMAT_CMDCANCEL_LABEL&quot;)
  2108. oControl.HelpText = _GetLabel(&quot;DLGFORMAT_CMDCANCEL_HELP&quot;)
  2109. Set oControl = oDialog.Model.getByName(&quot;cboFormat&quot;)
  2110. If UBound(pvList) &gt;= 0 Then
  2111. oControl.Text = pvList(0)
  2112. oControl.StringItemList = pvList
  2113. Else
  2114. oControl.Text = &quot;&quot;
  2115. oControl.StringItemList = Array()
  2116. End If
  2117. iOKCancel = oDialog.Execute()
  2118. Select Case iOKCancel
  2119. Case 1 &apos; OK
  2120. _PromptFormat = oControl.Text
  2121. Case 0 &apos; Cancel
  2122. _PromptFormat = &quot;&quot;
  2123. Case Else
  2124. End Select
  2125. oDialog.Dispose()
  2126. End Function &apos; _PromptFormat V0.8.5
  2127. REM -----------------------------------------------------------------------------------------------------------------------
  2128. Public Function _SelectWindow(Optional ByVal piWindowType As Integer, Optional ByVal psWindow As String) As Object
  2129. &apos; No argument: find active window
  2130. &apos; 2 arguments: find corresponding window
  2131. &apos; Return a _Window object type describing the found window
  2132. Dim oEnum As Object, oDesk As Object, oComp As Object, oFrame As Object, i As Integer
  2133. Dim bFound As Boolean, bActive As Boolean, sName As String, iType As Integer, sDocumentType As String
  2134. Dim sImplementation As String, vLocation() As Variant
  2135. Dim oWindow As _Window
  2136. Dim vPersistent As Variant, oForm As Object
  2137. If _ErrorHandler() Then On Local Error Goto Error_Function
  2138. bActive = IsMissing(piWindowType)
  2139. If IsMissing(psWindow) Then psWindow = &quot;&quot;
  2140. Set oWindow.Frame = Nothing
  2141. oWindow.DocumentType = &quot;&quot;
  2142. If bActive Then
  2143. oWindow.WindowType = acDefault
  2144. oWindow._Name = &quot;&quot;
  2145. Else
  2146. oWindow.WindowType = piWindowType
  2147. Select Case piWindowType
  2148. Case acBasicIDE, acDatabaseWindow : oWindow._Name = &quot;&quot;
  2149. Case Else : oWindow._Name = psWindow
  2150. End Select
  2151. End If
  2152. iType = acDefault
  2153. sDocumentType = &quot;&quot;
  2154. Set oDesk = CreateUnoService(&quot;com.sun.star.frame.Desktop&quot;)
  2155. Set oEnum = oDesk.Components().createEnumeration
  2156. Do While oEnum.hasMoreElements
  2157. Set oComp = oEnum.nextElement
  2158. If Utils._hasUNOProperty(oComp, &quot;ImplementationName&quot;) Then sImplementation = oComp.ImplementationName Else sImplementation = &quot;&quot;
  2159. Select Case sImplementation
  2160. Case &quot;com.sun.star.comp.basic.BasicIDE&quot;
  2161. Set oFrame = oComp.CurrentController.Frame
  2162. iType = acBasicIDE
  2163. sName = &quot;&quot;
  2164. Case &quot;com.sun.star.comp.dba.ODatabaseDocument&quot;
  2165. Set oFrame = oComp.CurrentController.Frame
  2166. iType = acDatabaseWindow
  2167. sName = &quot;&quot;
  2168. Case &quot;SwXTextDocument&quot;
  2169. If HasUnoInterfaces(oComp, &quot;com.sun.star.frame.XModule&quot;) Then
  2170. Select Case oComp.Identifier
  2171. Case &quot;com.sun.star.sdb.FormDesign&quot; &apos; Form
  2172. iType = acForm
  2173. Case &quot;com.sun.star.sdb.TextReportDesign&quot; &apos; Report
  2174. iType = acReport
  2175. Case &quot;com.sun.star.text.TextDocument&quot; &apos; Writer
  2176. vLocation = Split(oComp.getLocation(), &quot;/&quot;)
  2177. If UBound(vLocation) &gt;= 0 Then sName = Join(Split(vLocation(UBound(vLocation)), &quot;%20&quot;), &quot; &quot;) Else sName = &quot;&quot;
  2178. iType = acDocument
  2179. sDocumentType = docWriter
  2180. End Select
  2181. If iType = acForm Then &apos; Identify persistent Form name
  2182. vPersistent = Split(oComp.StringValue, &quot;/&quot;)
  2183. sName = _GetHierarchicalName(vPersistent(UBound(vPersistent) - 1))
  2184. ElseIf iType = acReport Then &apos; Identify Report name
  2185. For i = 0 To UBound(oComp.Args())
  2186. If oComp.Args(i).Name = &quot;DocumentTitle&quot; Then
  2187. sName = oComp.Args(i).Value
  2188. Exit For
  2189. End If
  2190. Next i
  2191. End If
  2192. Set oFrame = oComp.CurrentController.Frame
  2193. End If
  2194. Case &quot;org.openoffice.comp.dbu.ODatasourceBrowser&quot;
  2195. Set oFrame = oComp.Frame
  2196. If Not IsEmpty(oComp.Selection) Then &apos; Empty for (F4) DatasourceBrowser !!
  2197. For i = 0 To UBound(oComp.Selection())
  2198. If oComp.Selection(i).Name = &quot;Command&quot; Then
  2199. sName = oComp.Selection(i).Value
  2200. ElseIf oComp.Selection(i).Name = &quot;CommandType&quot; Then
  2201. Select Case oComp.selection(i).Value
  2202. Case com.sun.star.sdb.CommandType.TABLE
  2203. iType = acTable
  2204. Case com.sun.star.sdb.CommandType.QUERY
  2205. iType = acQuery
  2206. Case com.sun.star.sdb.CommandType.COMMAND
  2207. iType = acQuery &apos; SQL for future use ?
  2208. End Select
  2209. End If
  2210. Next i
  2211. &apos; Else ignore
  2212. End If
  2213. Case &quot;org.openoffice.comp.dbu.OTableDesign&quot;, &quot;org.openoffice.comp.dbu.OQueryDesign&quot; &apos; Table or Query in Edit mode
  2214. If Not bActive Then
  2215. If UCase(Right(oComp.Title, Len(psWindow))) = UCase(psWindow) Then &apos; No rigorous mean found to identify Name
  2216. Set oFrame = oComp.Frame
  2217. Select Case sImplementation
  2218. Case &quot;org.openoffice.comp.dbu.OTableDesign&quot; : iType = acTable
  2219. Case &quot;org.openoffice.comp.dbu.OQueryDesign&quot; : iType = acQuery
  2220. End Select
  2221. sName = Right(oComp.Title, Len(psWindow))
  2222. End If
  2223. Else
  2224. Set oFrame = Nothing
  2225. End If
  2226. Case &quot;org.openoffice.comp.dbu.ORelationDesign&quot;
  2227. Set oFrame = oComp.Frame
  2228. iType = acDiagram
  2229. sName = &quot;&quot;
  2230. Case &quot;com.sun.star.comp.sfx2.BackingComp&quot; &apos; Welcome screen
  2231. Set oFrame = oComp.Frame
  2232. iType = acWelcome
  2233. sName = &quot;&quot;
  2234. Case Else &apos; Other Calc, ..., whatever documents
  2235. If Utils._hasUNOProperty(oComp, &quot;Location&quot;) Then
  2236. vLocation = Split(oComp.getLocation(), &quot;/&quot;)
  2237. If UBound(vLocation) &gt;= 0 Then sName = Join(Split(vLocation(UBound(vLocation)), &quot;%20&quot;), &quot; &quot;) Else sName = &quot;&quot;
  2238. iType = acDocument
  2239. If Utils._hasUNOProperty(oComp, &quot;Identifier&quot;) Then
  2240. Select Case oComp.Identifier
  2241. Case &quot;com.sun.star.sheet.SpreadsheetDocument&quot; : sDocumentType = docCalc
  2242. Case &quot;com.sun.star.presentation.PresentationDocument&quot; : sDocumentType = docImpress
  2243. Case &quot;com.sun.star.drawing.DrawingDocument&quot; : sDocumentType = docDraw
  2244. Case &quot;com.sun.star.formula.FormulaProperties&quot; : sDocumentType = docMath
  2245. Case Else : sDocumentType = &quot;&quot;
  2246. End Select
  2247. End If
  2248. Set oFrame = oComp.CurrentController.Frame
  2249. End If
  2250. End Select
  2251. If bActive And Not IsNull(oFrame) Then
  2252. If oFrame.ContainerWindow.IsActive() Then
  2253. bFound = True
  2254. Exit Do
  2255. End If
  2256. ElseIf iType = piWindowType And UCase(sName) = UCase(psWindow) Then
  2257. bFound = True
  2258. Exit Do
  2259. End If
  2260. Loop
  2261. If bFound Then
  2262. Set oWindow.Frame = oFrame
  2263. oWindow._Name = sName
  2264. oWindow.WindowType = iType
  2265. oWindow.DocumentType = sDocumentType
  2266. Else
  2267. Set oWindow.Frame = Nothing
  2268. End If
  2269. Exit_Function:
  2270. Set _SelectWindow = oWindow
  2271. Exit Function
  2272. Error_Function:
  2273. TraceError(TRACEABORT, Err, &quot;SelectWindow&quot;, Erl)
  2274. GoTo Exit_Function
  2275. End Function &apos; _SelectWindow V1.1.0
  2276. REM -----------------------------------------------------------------------------------------------------------------------
  2277. Private Function _SendWithAttachment( _
  2278. ByVal pvRecipients() As Variant _
  2279. , ByVal pvCcRecipients() As Variant _
  2280. , ByVal pvBccRecipients() As Variant _
  2281. , ByVal psSubject As String _
  2282. , ByVal pvAttachments() As Variant _
  2283. , ByVal pvBody As String _
  2284. , ByVal pbEditMessage As Boolean _
  2285. ) As Boolean
  2286. &apos; Send message with attachments
  2287. If _ErrorHandler() Then On Local Error Goto Error_Function
  2288. _SendWithAttachment = False
  2289. Const cstWindows = 1
  2290. Const cstLinux = 4
  2291. Const cstSemiColon = &quot;;&quot;
  2292. Dim oServiceMail as Object, oMail As Object, oMessage As Object, vFlag As Variant
  2293. Dim vCc() As Variant, i As Integer, iOS As Integer, sProduct As String, bMailProvider As Boolean
  2294. &apos;OPENOFFICE &lt;= 3.6 and LIBREOFFICE have XSimple...Mail interface while OPENOFFICE &gt;= 4.0 has XSystemMailProvider interface
  2295. sProduct = UCase(Utils._GetProductName())
  2296. bMailProvider = ( Left(sProduct, 4) = &quot;OPEN&quot; And Left(_GetProductName(&quot;VERSION&quot;), 3) &gt;= &quot;4.0&quot; )
  2297. iOS = GetGuiType()
  2298. Select Case iOS
  2299. Case cstLinux
  2300. oServiceMail = createUnoService(&quot;com.sun.star.system.SimpleCommandMail&quot;)
  2301. Case cstWindows
  2302. If bMailProvider Then oServiceMail = createUnoService(&quot;com.sun.star.system.SystemMailProvider&quot;) _
  2303. Else oServiceMail = createUnoService(&quot;com.sun.star.system.SimpleSystemMail&quot;)
  2304. Case Else
  2305. Goto Error_Mail
  2306. End Select
  2307. If bMailProvider Then Set oMail = oServiceMail.queryMailClient() _
  2308. Else Set oMail = oServiceMail.querySimpleMailClient()
  2309. If IsNull(oMail) Then Goto Error_Mail
  2310. &apos;Reattribute Recipients &gt;= 2nd to ccRecipients
  2311. If UBound(pvRecipients) &lt;= 0 Then
  2312. If UBound(pvCcRecipients) &gt;= 0 Then vCc = pvCcRecipients
  2313. Else
  2314. ReDim vCc(0 To UBound(pvRecipients) - 1 + UBound(pvCcRecipients) + 1)
  2315. For i = 0 To UBound(pvRecipients) - 1
  2316. vCc(i) = pvRecipients(i + 1)
  2317. Next i
  2318. For i = UBound(pvRecipients) To UBound(vCc)
  2319. vCc(i) = pvCcRecipients(i - UBound(pvRecipients))
  2320. Next i
  2321. End If
  2322. If bMailProvider Then
  2323. Set oMessage = oMail.createMailMessage()
  2324. If UBound(pvRecipients) &gt;= 0 Then oMessage.Recipient = pvRecipients(0)
  2325. If psSubject &lt;&gt; &quot;&quot; Then oMessage.Subject = psSubject
  2326. Select Case iOS &apos; Not published differences between com.sun.star.system.SimpleCommandMail and SimpleSystemMail
  2327. Case cstLinux
  2328. If UBound(vCc) &gt;= 0 Then oMessage.CcRecipient = Array(Join(vCc, cstSemiColon))
  2329. If UBound(pvBccRecipients) &gt;= 0 Then oMessage.BccRecipient = Array(Join(pvBccRecipients, cstSemiColon))
  2330. Case cstWindows
  2331. If UBound(vCc) &gt;= 0 Then oMessage.CcRecipient = vCc
  2332. If UBound(pvBccRecipients) &gt;= 0 Then oMessage.BccRecipient = pvBccRecipients
  2333. End Select
  2334. If UBound(pvAttachments) &gt;= 0 Then oMessage.Attachement = pvAttachments
  2335. If pvBody &lt;&gt; &quot;&quot; Then oMessage.Body = pvBody
  2336. If pbEditMessage Then
  2337. vFlag = com.sun.star.system.MailClientFlags.DEFAULTS
  2338. Else
  2339. vFlag = com.sun.star.system.MailClientFlags.NO_USER_INTERFACE
  2340. End If
  2341. oMail.sendMailMessage(oMessage, vFlag)
  2342. Else
  2343. Set oMessage = oMail.createSimpleMailMessage() &apos; Body NOT SUPPORTED !
  2344. If UBound(pvRecipients) &gt;= 0 Then oMessage.setRecipient(pvRecipients(0))
  2345. If psSubject &lt;&gt; &quot;&quot; Then oMessage.setSubject(psSubject)
  2346. Select Case iOS
  2347. Case cstLinux
  2348. If UBound(vCc) &gt;= 0 Then oMessage.setCcRecipient(Array(Join(vCc, cstSemiColon)))
  2349. If UBound(pvBccRecipients) &gt;= 0 Then oMessage.setBccRecipient(Array(Join(pvBccRecipients, cstSemiColon)))
  2350. Case cstWindows
  2351. If UBound(vCc) &gt;= 0 Then oMessage.setCcRecipient(vCc)
  2352. If UBound(pvBccRecipients) &gt;= 0 Then oMessage.setBccRecipient(pvBccRecipients)
  2353. End Select
  2354. If UBound(pvAttachments) &gt;= 0 Then oMessage.setAttachement(pvAttachments)
  2355. If pbEditMessage Then
  2356. vFlag = com.sun.star.system.SimpleMailClientFlags.DEFAULTS
  2357. Else
  2358. vFlag = com.sun.star.system.SimpleMailClientFlags.NO_USER_INTERFACE
  2359. End If
  2360. oMail.sendSimpleMailMessage(oMessage, vFlag)
  2361. End If
  2362. _SendWithAttachment = True
  2363. Exit_Function:
  2364. Exit Function
  2365. Error_Function:
  2366. TraceError(TRACEABORT, Err, &quot;_SendWithAttachment&quot;, Erl)
  2367. Goto Exit_Function
  2368. Error_Mail:
  2369. TraceError(TRACEFATAL, ERRSENDMAIL, Utils._CalledSub(), 0)
  2370. Goto Exit_Function
  2371. End Function &apos; _SendWithAttachment V0.9.5
  2372. REM -----------------------------------------------------------------------------------------------------------------------
  2373. Private Function _SendWithoutAttachment(ByVal pvTo As Variant _
  2374. , ByVal pvCc As Variant _
  2375. , ByVal pvBcc As Variant _
  2376. , ByVal psSubject As String _
  2377. , ByVal psBody As String _
  2378. ) As Boolean
  2379. &apos;Send simple message with mailto: syntax
  2380. Dim sMailTo As String, sTo As String, sCc As String, sBcc As String, oDispatch As Object
  2381. Const cstComma = &quot;,&quot;
  2382. If _ErrorHandler() Then On Local Error Goto Error_Function
  2383. If UBound(pvTo) &gt;= 0 Then sTo = Trim(Join(pvTo, cstComma)) Else sTo = &quot;&quot;
  2384. If UBound(pvCc) &gt;= 0 Then sCc = Trim(Join(pvCc, cstComma)) Else sCc = &quot;&quot;
  2385. If UBound(pvBcc) &gt;= 0 Then sBcc = Trim(Join(pvBcc, cstComma)) Else sBcc = &quot;&quot;
  2386. sMailTo = &quot;mailto:&quot; _
  2387. &amp; sTo &amp; &quot;?&quot; _
  2388. &amp; Iif(sCc = &quot;&quot;, &quot;&quot;, &quot;cc=&quot; &amp; sCc &amp; &quot;&amp;&quot;) _
  2389. &amp; Iif(sBcc = &quot;&quot;, &quot;&quot;, &quot;bcc=&quot; &amp; sBcc &amp; &quot;&amp;&quot;) _
  2390. &amp; Iif(psSubject = &quot;&quot;, &quot;&quot;, &quot;subject=&quot; &amp; psSubject &amp; &quot;&amp;&quot;) _
  2391. &amp; Iif(psBody = &quot;&quot;, &quot;&quot;, &quot;body=&quot; &amp; psBody &amp; &quot;&amp;&quot;)
  2392. If Right(sMailTo, 1) = &quot;&amp;&quot; Or Right(sMailTo, 1) = &quot;?&quot; Then sMailTo = Left(sMailTo, Len(sMailTo) - 1)
  2393. sMailTo = ConvertToUrl(sMailTo)
  2394. oDispatch = createUnoService( &quot;com.sun.star.frame.DispatchHelper&quot;)
  2395. oDispatch.executeDispatch(StarDesktop, sMailTo, &quot;&quot;, 0, Array())
  2396. _SendWithoutAttachment = True
  2397. Exit_Function:
  2398. Exit Function
  2399. Error_Function:
  2400. TraceError(TRACEABORT, Err, &quot;_SendWithoutAttachments&quot;, Erl)
  2401. _SendWithoutAttachment = False
  2402. Goto Exit_Function
  2403. End Function &apos; _SendWithoutAttachment V0.8.5
  2404. REM -----------------------------------------------------------------------------------------------------------------------
  2405. Private Sub _ShellExecute(sCommand As String)
  2406. &apos; Execute shell command
  2407. Dim oShell As Object
  2408. Set oShell = createUnoService(&quot;com.sun.star.system.SystemShellExecute&quot;)
  2409. oShell.execute(sCommand, &quot;&quot; , com.sun.star.system.SystemShellExecuteFlags.URIS_ONLY)
  2410. End Sub &apos; _ShellExecute V0.8.5
  2411. </script:module>