diff options
| author | Ilmari Lauhakangas <ilmari.lauhakangas@libreoffice.org> | 2022-04-12 18:32:29 +0300 |
|---|---|---|
| committer | Ilmari Lauhakangas <ilmari.lauhakangas@libreoffice.org> | 2022-04-13 08:16:52 +0200 |
| commit | e568c9dca8b93b96a8a130a8fb6f1bba1a33d6ea (patch) | |
| tree | 925e4596e68d5833d887e778e6eead7353376b49 /wizards/source/access2base | |
| parent | c7970e3204f7e2d958d213c42a9f0db232578a62 (diff) | |
Update remaining DevGuide wiki links.
My Kate editor decided to do some whitespace cleanup, but maybe
it's fine as the main changes are not targeting functional bits anyway.
Change-Id: I5292e77e43055f94a6256a7f72d49fd59287d194
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/132928
Tested-by: Ilmari Lauhakangas <ilmari.lauhakangas@libreoffice.org>
Reviewed-by: Ilmari Lauhakangas <ilmari.lauhakangas@libreoffice.org>
Diffstat (limited to 'wizards/source/access2base')
| -rw-r--r-- | wizards/source/access2base/Database.xba | 60 | ||||
| -rw-r--r-- | wizards/source/access2base/DoCmd.xba | 184 | ||||
| -rw-r--r-- | wizards/source/access2base/Utils.xba | 90 |
3 files changed, 167 insertions, 167 deletions
diff --git a/wizards/source/access2base/Database.xba b/wizards/source/access2base/Database.xba index 5a5b1cf2b1f8..347eafeb499d 100644 --- a/wizards/source/access2base/Database.xba +++ b/wizards/source/access2base/Database.xba @@ -294,14 +294,14 @@ Dim oQuery As Object, oQueries As Object, i As Integer, sQueryName As String If Not Utils._CheckArgument(pvSql, 2, vbString) Then Goto Exit_Function If pvSql = "" Then Call _TraceArguments() If Not Utils._CheckArgument(pvOption, 3, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function - + If _ReadOnly Then Goto Error_NoUpdate - + Set oQuery = CreateUnoService("com.sun.star.sdb.QueryDefinition") oQuery.rename(pvQueryName) oQuery.Command = _ReplaceSquareBrackets(pvSql) oQuery.EscapeProcessing = Not ( pvOption = dbSQLPassThrough ) - + Set oQueries = Document.DataSource.getQueryDefinitions() With oQueries For i = 0 To .getCount() - 1 @@ -348,9 +348,9 @@ Dim vNameComponents() As Variant, iNames As Integer If Not Utils._CheckArgument(pvTableName, 1, vbString) Then Goto Exit_Function If pvTableName = "" Then Call _TraceArguments() - + If _ReadOnly Then Goto Error_NoUpdate - + Set oTables = Connection.getTables With oTables sTables = .ElementNames() @@ -561,7 +561,7 @@ Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("Database.getProperty") - + End Function ' getProperty REM ----------------------------------------------------------------------------------------------------------------------- @@ -570,7 +570,7 @@ Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function - + End Function ' hasProperty REM ----------------------------------------------------------------------------------------------------------------------- @@ -654,7 +654,7 @@ Dim iType As Integer, iOptions As Integer, iLockEdit As Integer lCommandType = com.sun.star.sdb.CommandType.QUERY End If End Select - + Set oObject = New Recordset With oObject ._CommandType = lCommandType @@ -699,7 +699,7 @@ Public Function OpenSQL(Optional ByVal pvSQL As Variant _ Const cstThisSub = "Database.OpenSQL" Utils._SetCalledSub(cstThisSub) - + OpenSQL = False If IsMissing(pvSQL) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function @@ -763,7 +763,7 @@ Const cstThisSub = "Database.OutputTo" Utils._SetCalledSub(cstThisSub) OutputTo = False - + If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery, acOutputArray)) Then Goto Exit_Function If IsMissing(pvObjectName) Then Call _TraceArguments() If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function @@ -804,7 +804,7 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp If pvObjectType = acOutputTable Then Set oTable = TableDefs(pvObjectName, True) Else Set oTable = Querydefs(pvObjectName, True) If IsNull(oTable) Then Goto Error_NotFound End If - + 'Determine format and parameters If pvOutputFormat = "" Then sOutputFormat = _PromptFormat(Array("HTML", "ODS", "XLS", "XLSX", "TXT")) ' Prompt user for format @@ -826,7 +826,7 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp If sOutputFile = "" Then Goto Exit_Function Else sOutputFile = pvOutputFile - End If + End If sOutputFile = ConvertToURL(sOutputFile) 'Create file @@ -846,7 +846,7 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp Case UCase(acFormatTXT), "TXT", "CSV" bOutput = _OutputToCalc(oTable, sOutputFile, acFormatTXT, pvEncoding) End Select - + 'Launch application, if requested If bOutput Then If pvAutoStart Then Call _ShellExecute(sOutputFile) @@ -855,7 +855,7 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp End If OutputTo = True - + Exit_Function: If Not IsNull(oTable) Then oTable.Dispose() @@ -891,7 +891,7 @@ Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Set vProperty._ParentDatabase = _This - + Exit_Function: Set Properties = vProperty Utils._ResetCalledSub("Database.Properties") @@ -913,7 +913,7 @@ Dim i As Integer, bFound As Boolean, oQueries As Object If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If - + Set oQueries = Connection.getQueries sObjects = oQueries.ElementNames() Select Case True @@ -975,7 +975,7 @@ Public Function Recordsets(ByVal Optional pvIndex As Variant) As Object If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If - + Dim sObjects() As String, sObjectName As String, oObject As Object Dim i As Integer, bFound As Boolean, oTables As Object @@ -1022,7 +1022,7 @@ Public Function RunSQL(Optional ByVal pvSQL As Variant _ Const cstThisSub = "Database.RunSQL" Utils._SetCalledSub(cstThisSub) - + RunSQL = False If IsMissing(pvSQL) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function @@ -1068,7 +1068,7 @@ Dim i As Integer, bFound As Boolean, oTables As Object If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If - + Set oTables = Connection.getTables sObjects = oTables.ElementNames() Select Case True @@ -1631,7 +1631,7 @@ Dim i As Integer, l As Long lCurrentChar = Len(psString) + 1 End If Loop - + _OutputStringToHTML = sOutput End Function ' _OutputStringToHTML V1.4.0 @@ -1642,8 +1642,8 @@ Private Function _OutputToCalc(poData As Object _ , ByVal psFilter As String _ , Optional ByVal plEncoding As Long _ ) As Boolean -' https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Database_Import -' https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options +' https://wiki.documentfoundation.org/Documentation/DevGuide/Spreadsheet_Documents#Database_Import +' https://wiki.documentfoundation.org/Documentation/DevGuide/Spreadsheet_Documents#Filter_Options Dim oCalcDoc As Object, oSheet As Object, vWin As Variant Dim vImportDesc() As Variant, iSource As Integer @@ -1701,7 +1701,7 @@ Dim oRange As Object, i As Integer, iCol As Integer, oColumns As Object , _MakePropertyValue("Overwrite", True) _ )) End Select - + oCalcDoc.close(False) _OutputToCalc = True @@ -1744,7 +1744,7 @@ Const cstTitleAlt = "<!--AccessTemplate_Title-->", cstBodyAlt = vTemplate = _ReadFileIntoArray(psTemplateFile) If LBound(vTemplate) > UBound(vTemplate) Then vTemplate() = vMinimalTemplate() - + bDataArray = IsNull(pvTable) ' Write output file @@ -1806,7 +1806,7 @@ Dim i As Integer, vEvents As Variant, sEvent As String, vEvent As Variant Utils._SetCalledSub("Database.get" & psProperty) _PropertyGet = EMPTY - + Select Case UCase(psProperty) Case UCase("Connect") If IsNull(Document) Then _PropertyGet = "" Else _PropertyGet = Document.Datasource.URL @@ -1846,7 +1846,7 @@ Dim i As Integer, vEvents As Variant, sEvent As String, vEvent As Variant Case Else Goto Trace_Error End Select - + Exit_Function: Utils._ResetCalledSub("Database.get" & psProperty) Exit Function @@ -1868,7 +1868,7 @@ Public Function _ReplaceSquareBrackets(ByVal psSql As String) As String Dim sQuote As String 'RDBMS specific quote character Dim vSubStrings() As Variant, i As Integer Const cstSingleQuote = "'" - + sQuote = MetaData.IdentifierQuoteString If sQuote = " " Then ' IdentifierQuoteString returns a space " " if identifier quoting is not supported. _ReplaceSquareBrackets = Trim(psSql) @@ -1881,9 +1881,9 @@ Const cstSingleQuote = "'" vSubStrings(i) = Join(Split(vSubStrings(i), "]"), sQuote) End If Next i - + _ReplaceSquareBrackets = Trim(Join(vSubStrings, cstSingleQuote)) - + End Function ' ReplaceSquareBrackets V1.1.0 -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba index 73d3855843ba..12c62714d775 100644 --- a/wizards/source/access2base/DoCmd.xba +++ b/wizards/source/access2base/DoCmd.xba @@ -31,7 +31,7 @@ Type _Window _Name As String ' Object Name WindowType As Integer ' One of the object types DocumentType As String ' Writer, Calc, ... - Only if WindowType = acDocument -End Type +End Type REM VBA allows call to actions with missing arguments e.g. OpenForm("aaa",,"[field]=2") REM in StarBasic IsMissing requires Variant parameters @@ -48,7 +48,7 @@ Public Function ApplyFilter( _ Const cstThisSub = "ApplyFilter" Utils._SetCalledSub(cstThisSub) ApplyFilter = False - + If IsMissing(pvFilter) And IsMissing(pvSQL) Then Call _TraceArguments() If IsMissing(pvFilter) Then pvFilter = "" If Not Utils._CheckArgument(pvFilter, 1, vbString) Then Goto Exit_Function @@ -89,7 +89,7 @@ Dim sFilter As String, oWindow As Object, oDatabase As Object, oTarget As Object Exit_Function: Utils._ResetCalledSub(cstThisSub) - Exit Function + Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function @@ -115,13 +115,13 @@ Const cstThisSub = "Close" And Utils._CheckArgument(pvObjectName, 2, vbString) _ And Utils._CheckArgument(pvSave, 3, Utils._AddNumeric(), Array(acSavePrompt)) _ ) Then Goto Exit_Function - + Dim sObjects() As String, sObjectName As String, oController As Object, oObject As Object Dim i As Integer, bFound As Boolean, lComponent As Long Dim oDatabase As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable - + ' Check existence of object and find its exact (case-sensitive) name Select Case pvObjectType Case acForm @@ -146,7 +146,7 @@ Dim oDatabase As Object End If Next i If Not bFound Then Goto Trace_NotFound - + Select Case pvObjectType Case acForm Set oController = oDatabase.Document.getFormDocuments.getByHierarchicalName(sObjectName) @@ -204,7 +204,7 @@ Const cstThisSub = "CopyObject" ) Then Goto Exit_Function If IsMissing(pvSourceName) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSourceName, 2, vbString) Then Goto Exit_Function - + Dim oSource As Object, oSourceDatabase As Object, oTarget As Object, oDatabase As Object, bSameDatabase As Boolean Dim oSourceTable As Object, oSourceColumns As Object, oSourceCol As Object, oTargetCol As Object, iRDBMS As Integer Dim oSourceKeys As Object, oSourceKey As Object, oTargetKey As Object @@ -232,7 +232,7 @@ Const cstProgressMeterLimit = 100 Else Set oSourceDatabase = pvSourceDatabase End If - + With oDatabase iRDBMS = ._RDBMS If ._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable @@ -382,13 +382,13 @@ Const cstProgressMeterLimit = 100 Set oInput = Nothing if bProgressMeter Then Application.SysCmd acSysCmdClearStatus End Select - + Case Else End Select End With - + CopyObject = True - + Exit_Function: ' Avoid closing the current database or the database object given as source argument If VarType(pvSourceDatabase) = vbString And Not bSameDatabase Then @@ -447,9 +447,9 @@ Dim vFindValue As Variant, oFindrecord As Object ' Move cursor to the initial row. Operation based on last FindRecord, not on user interactions done inbetween If ofForm.DatabaseForm.RowCount <= 0 then Goto Exit_Function ' Dataset is empty - + lInitialRow = .LastRow ' Used if Search = acSearchAll - + bFound = False lFindRow = .LastRow b2ndRound = False @@ -484,7 +484,7 @@ Dim vFindValue As Variant, oFindrecord As Object Else .LastColumn = .LastColumn + 1 End If - + ' Examine column contents If .LastColumn <= UBound(.ColumnNames) Then For i = .LastColumn To UBound(.ColumnNames) @@ -506,7 +506,7 @@ Dim vFindValue As Variant, oFindrecord As Object bFound = ( InStr(1, vFindValue, .FindWhat, 0) > 0 ) Else bFound = ( InStr(vFindValue, .FindWhat) > 0 ) - End If + End If Case acEntire If .MatchCase Then bFound = ( .FindWhat = vFindValue ) @@ -530,11 +530,11 @@ Dim vFindValue As Variant, oFindrecord As Object If bFound Then ocGrid.Controls(.ColumnNames(.LastColumn)).setFocus() .FindRecord = 1 - FindNext = True + FindNext = True End If End With - + Exit_Function: Utils._ResetCalledSub("FindNext") Exit Function @@ -564,7 +564,7 @@ Public Function FindRecord(Optional ByVal pvFindWhat As Variant _ If _ErrorHandler() Then On Local Error Goto Error_Function FindRecord = False - + Utils._SetCalledSub("FindRecord") If IsMissing(pvFindWhat) Or pvFindWhat = "" Then Call _TraceArguments() If IsMissing(pvMatch) Then pvMatch = acEntire @@ -584,7 +584,7 @@ Public Function FindRecord(Optional ByVal pvFindWhat As Variant _ If VarType(pvTargetedField) <> vbString Then If Not Utils._CheckArgument(pvTargetedField, 6, Utils._AddNumeric(), Array(acAll, acCurrent)) Then Exit Function End If - + Dim ocTarget As Object, i As Integer, j As Integer, vNames() As Variant, iCount As Integer, vIndexes() As Variant Dim vColumn As Variant, vDataField As Variant, ofParentForm As Variant, oColumns As Object, vParentGrid As Object Dim bFound As Boolean, ocGridControl As Object, iFocus As Integer @@ -597,16 +597,16 @@ Dim oFindRecord As _FindParams .Search = pvSearch .SearchAsFormatted = pvSearchAsFormatted .FindFirst = pvFindFirst - + ' Determine target ' Either: pvTargetedField = Grid => search all fields ' pvTargetedField = Control in Grid => search only in that column ' pvTargetedField = acAll or acCurrent => determine focus Select Case True - + Case VarType(pvTargetedField) = vbString Set ocTarget = getObject(pvTargetedField) - + If ocTarget.SubType = CTLGRIDCONTROL Then .OnlyCurrentField = acAll .GridControl = ocTarget._Shortcut @@ -633,7 +633,7 @@ Dim oFindRecord As _FindParams End If End If Next i - + ElseIf ocTarget._Type = OBJCONTROL Then ' Control within a grid tbc If IsNull(ocTarget.ControlModel.BoundField) Then Goto Error_Target ' Control MUST be bound to a database record or query ' BoundField is in ControlModel, thanks PASTIM ! @@ -657,7 +657,7 @@ Dim oFindRecord As _FindParams End If Next j End If - + Case Else ' Determine focus iCount = Application.Forms()._Count If iCount = 0 Then Goto Error_ActiveForm @@ -684,7 +684,7 @@ Dim oFindRecord As _FindParams .GridControl= ocGridControl._Shortcut iFocus = -1 iFocus = ocGridControl.ControlView.getCurrentColumnPosition() ' Deprecated but no alternative found !! - + If pvTargetedField = acAll Or iFocus < 0 Or iFocus >= ocGridControl.ControlModel.Count Then ' Has a control within the grid the focus ? NO .OnlyCurrentField = acAll Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns @@ -707,7 +707,7 @@ Dim oFindRecord As _FindParams End If End If Next i - + Else ' Has a control within the grid the focus ? YES .OnlyCurrentField = acCurrent Set vColumn = ocGridControl.ControlModel.getByIndex(iFocus) @@ -728,7 +728,7 @@ Dim oFindRecord As _FindParams End If End Select - + .Form = ofParentForm._Shortcut .LastColumn = UBound(vNames) .ColumnNames = vNames @@ -755,11 +755,11 @@ Dim oFindRecord As _FindParams End If .FindRecord = 1 - + End With Set _A2B_.FindRecord = oFindRecord FindRecord = DoCmd.Findnext() - + Exit_Function: Utils._ResetCalledSub("FindRecord") Exit Function @@ -788,7 +788,7 @@ Public Function GetHiddenAttribute(ByVal Optional pvObjectType As Variant _ If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "GetHiddenAttribute" Utils._SetCalledSub(cstThisSub) - + If IsMissing(pvObjectType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _ Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow, acDocument) _ @@ -802,7 +802,7 @@ Const cstThisSub = "GetHiddenAttribute" Else If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function End If - + Dim oWindow As Object Set oWindow = _SelectWindow(pvObjectType, pvObjectName) If IsNull(oWindow.Frame) Then Goto Error_NotFound @@ -828,7 +828,7 @@ Public Function GoToControl(Optional ByVal pvControlName As Variant) As Boolean Utils._SetCalledSub("GoToControl") If IsMissing(pvControlName) Then Call _TraceArguments() If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function - + GoToControl = False Dim oWindow As Object, ofForm As Object, ocControl As Object Dim i As Integer, iCount As Integer @@ -849,7 +849,7 @@ Dim i As Integer, iCount As Integer End If Next i End If - + Exit_Function: Utils._ResetCalledSub("GoToControl") Exit Function @@ -869,7 +869,7 @@ Public Function GoToRecord(Optional ByVal pvObjectType As Variant _ If _ErrorHandler() Then On Local Error Goto Error_Function GoToRecord = False - + Const cstThisSub = "GoTorecord" Utils._SetCalledSub(cstThisSub) If IsMissing(pvObjectName) Then pvObjectName = "" @@ -885,7 +885,7 @@ Const cstThisSub = "GoTorecord" ) Then Goto Exit_Function If pvObjectType = acActiveDataObject And pvObjectName <> "" Then Goto Error_Target If pvOffset < 0 And pvRecord <> acGoTo Then Goto Error_Offset - + Dim ofForm As Object, oGeneric As Object, oResultSet As Object, oWindow As Object Dim i As Integer, iCount As Integer, bFound As Boolean, lOffset As Long Dim sObjectName, iLengthName As Integer @@ -923,7 +923,7 @@ Dim sObjectName, iLengthName As Integer Case sObjectName = "" Call _TraceArguments() Case Else - Set ofForm = Application.Forms(pvObjectName) + Set ofForm = Application.Forms(pvObjectName) End Select Set oResultSet = ofForm.DatabaseForm Case acDataQuery @@ -937,14 +937,14 @@ Dim sObjectName, iLengthName As Integer Set oResultSet = oWindow.Frame.Controller.FormOperations.Cursor Case Else End Select - + ' Check if current row updated => Save it If oResultSet.IsNew Then oResultSet.insertRow() ElseIf oResultSet.IsModified Then oResultSet.updateRow() End If - + lOffset = pvOffset Select Case pvRecord Case acFirst : GoToRecord = oResultSet.first() @@ -967,7 +967,7 @@ Dim sObjectName, iLengthName As Integer GoToRecord = oResultSet.relative(- lOffset) End If End Select - + Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function @@ -1037,7 +1037,7 @@ Public Function MoveSize(ByVal Optional pvLeft As Variant _ If Not Utils._CheckArgument(pvTop, 2, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvWidth, 3, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvHeight, 4, Utils._AddNumeric()) Then Goto Exit_Function - + Dim iArg As Integer, iWrong As Integer ' Check arguments values iArg = 0 If pvHeight < -1 Then @@ -1073,7 +1073,7 @@ Dim oWindow As Object MoveSize = True End If End With - + Exit_Function: Utils._ResetCalledSub("MoveSize") Exit Function @@ -1110,13 +1110,13 @@ Public Function OpenForm(Optional ByVal pvFormName As Variant _ And Utils._CheckArgument(pvDataMode, 5, Utils._AddNumeric(), Array(acFormAdd, acFormEdit, acFormPropertySettings, acFormReadOnly)) _ And Utils._CheckArgument(pvWindowMode, 6, Utils._AddNumeric(), Array(acDialog, acHidden, acIcon, acWindowNormal)) _ ) Then Goto Exit_Function - + Dim ofForm As Object, sWarning As String Dim oDatabase As Object, oOpenForm As Object, bOpenMode As Boolean, oController As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable - + Set ofForm = Application.AllForms(pvFormName) If ofForm.IsLoaded Then sWarning = _GetLabel("ERR" & ERRFORMYETOPEN) @@ -1155,7 +1155,7 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object oForm.reload() End If End If - + 'Housekeeping Set ofForm = Application.AllForms(pvFormName) ' Redone to reinitialize all properties of ofForm now FormName is open With ofForm @@ -1214,7 +1214,7 @@ Public Function OpenQuery(Optional ByVal pvQueryName As Variant _ If IsMissing(pvQueryName) Then Call _TraceArguments() If IsMissing(pvView) Then pvView = acViewNormal If IsMissing(pvDataMode) Then pvDataMode = acEdit - OpenQuery = DoCmd._OpenObject("Query", pvQueryName, pvView, pvDataMode) + OpenQuery = DoCmd._OpenObject("Query", pvQueryName, pvView, pvDataMode) Exit_Function: Utils._ResetCalledSub("OpenQuery") @@ -1236,7 +1236,7 @@ Public Function OpenReport(Optional ByVal pvReportName As Variant _ If IsMissing(pvReportName) Then Call _TraceArguments() If IsMissing(pvView) Then pvView = acViewNormal If IsMissing(pvDataMode) Then pvDataMode = acEdit - OpenReport = DoCmd._OpenObject("Report", pvReportName, pvView, pvDataMode) + OpenReport = DoCmd._OpenObject("Report", pvReportName, pvView, pvDataMode) Exit_Function: Utils._ResetCalledSub("OpenReport") @@ -1257,7 +1257,7 @@ Public Function OpenSQL(Optional ByVal pvSQL As Variant _ If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("OpenSQL") - + OpenSQL = False If IsMissing(pvSQL) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function @@ -1290,7 +1290,7 @@ Public Function OpenTable(Optional ByVal pvTableName As Variant _ If IsMissing(pvTableName) Then Call _TraceArguments() If IsMissing(pvView) Then pvView = acViewNormal If IsMissing(pvDataMode) Then pvDataMode = acEdit - OpenTable = DoCmd._OpenObject("Table", pvTableName, pvView, pvDataMode) + OpenTable = DoCmd._OpenObject("Table", pvTableName, pvView, pvDataMode) Exit_Function: Utils._ResetCalledSub("OpenTable") @@ -1311,7 +1311,7 @@ Public Function OutputTo(ByVal pvObjectType As Variant _ , ByVal Optional pvQuality As Variant _ ) As Boolean REM https://wiki.openoffice.org/wiki/Framework/Article/Filter/FilterList_OOo_3_0 -REM https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options +REM https://wiki.documentfoundation.org/Documentation/DevGuide/Spreadsheet_Documents#Filter_Options REM https://msdn.microsoft.com/en-us/library/ms709353%28v=vs.85%29.aspx 'Supported: acFormatPDF, acFormatODT, acFormatDOC, acFormatHTML for forms ' acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT for tables and queries @@ -1321,7 +1321,7 @@ Const cstThisSub = "OutputTo" Utils._SetCalledSub(cstThisSub) OutputTo = False - + If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery, acOutputForm)) Then Goto Exit_Function If IsMissing(pvObjectName) Then pvObjectName = "" If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function @@ -1358,7 +1358,7 @@ Const cstThisSub = "OutputTo" ) GoTo Exit_Function End If - + Dim vWindow As Variant, sOutputFile As String, ofForm As Object, i As Integer, bFound As Boolean 'Find applicable form If pvObjectName = "" Then @@ -1376,7 +1376,7 @@ Dim vWindow As Variant, sOutputFile As String, ofForm As Object, i As Integer, b Next i If Not bFound Then Goto Error_NotFound End If - + 'Determine format and parameters Dim sOutputFormat As String, sFilter As String, oFilterData As Object, oExport As Object, sSuffix As String If pvOutputFormat = "" Then @@ -1410,26 +1410,26 @@ Dim sOutputFormat As String, sFilter As String, oFilterData As Object, oExport A _MakePropertyValue("FilterName", sFilter), _ _MakePropertyValue("FilterData", oFilterData), _ ) - + 'Determine output file If pvOutputFile = "" Then ' Prompt file picker to user sOutputFile = _PromptFilePicker(sSuffix) If sOutputFile = "" Then Goto Exit_Function Else sOutputFile = pvOutputFile - End If + End If sOutputFile = ConvertToURL(sOutputFile) 'Create file On Local Error Goto Error_File ofForm.Component.storeToURL(sOutputFile, oExport) On Local Error Goto Error_Function - + 'Launch application, if requested If pvAutoStart Then Call _ShellExecute(sOutputFile) OutputTo = True - + Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function @@ -1455,12 +1455,12 @@ Public Function Quit(Optional ByVal pvSave As Variant) As Variant If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "Quit" Utils._SetCalledSub(cstThisSub) - + If IsMissing(pvSave) Then pvSave = acQuitSaveAll If Not Utils._CheckArgument(pvSave, 1, Utils._AddNumeric(), _ Array(acQuitPrompt, acQuitSaveAll, acQuitSaveNone) _ ) Then Goto Exit_Function - + Dim oDatabase As Object, oDoc As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable @@ -1484,7 +1484,7 @@ Dim oDatabase As Object, oDoc As Object oDoc.dispose() End If End If - + Exit_Function: Utils._ResetCalledSub(cstThisSub) Set oDatabase = Nothing @@ -1506,7 +1506,7 @@ Public Sub RunApp(Optional ByVal pvCommandLine As Variant) If _ErrorHandler() Then On Local Error Goto Error_Sub Utils._SetCalledSub("RunApp") - + If IsMissing(pvCommandLine) Then Call _TraceArguments() If Not Utils._CheckArgument(pvCommandLine, 1, vbString) Then Goto Exit_Sub @@ -1528,14 +1528,14 @@ Public Function RunCommand(Optional pvCommand As Variant, Optional pbReturnComma If _ErrorHandler() Then On Local Error Goto Exit_Function ' Avoid any abort Const cstThisSub = "RunCommand" Utils._SetCalledSub(cstThisSub) - + Dim iVBACommand As Integer, sOOCommand As String, sDispatch As String If IsMissing(pvCommand) Then Call _TraceArguments() If Not ( Utils._CheckArgument(pvCommand, 1, Utils._AddNumeric(vbString)) ) Then Goto Exit_Function If IsMissing(pbReturnCommand) Then pbReturnCommand = False - + RunCommand = True - + Const cstUnoPrefix = ".uno:" If VarType(pvCommand) = vbString Then sOOCommand = pvCommand @@ -1548,7 +1548,7 @@ Const cstUnoPrefix = ".uno:" sOOCommand = "" iVBACommand = pvCommand End If - + Select Case True Case iVBACommand = acCmdAboutMicrosoftAccess Or UCase(sOOCommand) = "ABOUT" : sDispatch = "About" Case iVBACommand = acCmdAboutOpenOffice Or UCase(sOOCommand) = "ABOUT" : sDispatch = "About" @@ -1727,7 +1727,7 @@ Const cstUnoPrefix = ".uno:" If iVBACommand >= 0 Then Goto Exit_Function sDispatch = pvCommand End Select - + If pbReturnCommand Then RunCommand = cstUnoPrefix & sDispatch Else Call _DispatchCommand(cstUnoPrefix & sDispatch) Exit_Function: @@ -1748,7 +1748,7 @@ Public Function RunSQL(Optional ByVal pvSQL As Variant _ If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("RunSQL") - + RunSQL = False If IsMissing(pvSQL) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function @@ -1778,7 +1778,7 @@ Public Function SelectObject( ByVal Optional pvObjectType As Variant _ If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "SelectObject" Utils._SetCalledSub(cstThisSub) - + If IsMissing(pvObjectType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _ Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow, acDocument) _ @@ -1795,7 +1795,7 @@ Const cstThisSub = "SelectObject" If Not IsMissing(pvInDatabaseWindow) Then If Not Utils._CheckArgument(pvInDatabaseWindow, 3, vbBoolean, False) Then Goto Exit_Function End If - + Dim oWindow As Object Set oWindow = _SelectWindow(pvObjectType, pvObjectName) If IsNull(oWindow.Frame) Then Goto Error_NotFound @@ -1835,7 +1835,7 @@ Public Function SendObject(ByVal Optional pvObjectType As Variant _ If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("SendObject") SendObject = False - + If IsMissing(pvObjectType) Then pvObjectType = acSendNoObject If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acSendNoObject, acSendForm)) Then Goto Exit_Function If IsMissing(pvObjectName) Then pvObjectName = "" @@ -1930,7 +1930,7 @@ Public Function SetHiddenAttribute(ByVal Optional pvObjectType As Variant _ SetHiddenAttribute = False Const cstThisSub = "SetHiddenAttribute" Utils._SetCalledSub(cstThisSub) - + If IsMissing(pvObjectType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _ Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow), acDocument _ @@ -1949,7 +1949,7 @@ Const cstThisSub = "SetHiddenAttribute" Else If Not Utils._CheckArgument(pvHidden, 3, vbBoolean) Then Goto Exit_Function End If - + Dim oWindow As Object Set oWindow = _SelectWindow(pvObjectType, pvObjectName) If IsNull(oWindow.Frame) Then Goto Error_NotFound @@ -1978,7 +1978,7 @@ Public Function SetOrderBy( _ Const cstThisSub = "SetOrderBy" Utils._SetCalledSub(cstThisSub) SetOrderBy = False - + If IsMissing(pvOrder) Then pvOrder = "" If Not Utils._CheckArgument(pvOrder, 1, vbString) Then Goto Exit_Function If IsMissing(pvControlName) Then pvControlName = "" @@ -2013,7 +2013,7 @@ Dim sOrder As String, oWindow As Object, oDatabase As Object, oTarget As Object Exit_Function: Utils._ResetCalledSub(cstThisSub) - Exit Function + Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function @@ -2045,7 +2045,7 @@ Dim oWindow As Object, oDatabase As Object Exit_Function: Utils._ResetCalledSub(cstThisSub) - Exit Function + Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function @@ -2076,7 +2076,7 @@ Dim bFound As Boolean End With _CheckColumnType = bFound - + End Function ' _CheckColumnType V0.9.1 REM ----------------------------------------------------------------------------------------------------------------------- @@ -2111,7 +2111,7 @@ Dim iNbTypes As Integer, iBestFit As Integer, lFitPrecision As Long, lPrecision poTarget.IsCurrency = poSource.IsCurrency poTarget.IsNullable = poSource.IsNullable poTarget.Scale = poSource.Scale - + If piSourceRDBMS = poDatabase._RDBMS Or poDatabase._RDBMS = DBMS_UNKNOWN Then poTarget.Type = poSource.Type poTarget.Precision = poSource.Precision @@ -2161,7 +2161,7 @@ Error_Sub: TraceError(TRACEABORT, Err, "_ConvertDataDescriptor", Erl) Goto Exit_Sub End Sub ' ConvertDataDescriptor V1.6.0 - + REM ----------------------------------------------------------------------------------------------------------------------- Private Function _DatabaseForm(psForm As String, psControl As String) 'Return DatabaseForm element of Form object (based on psForm which is known as a real form name) @@ -2195,7 +2195,7 @@ Dim bFound As Boolean, i As Integer, sName As String End If Exit_Function: - Exit Function + Exit Function Trace_NotFound: TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(psControl, psForm)) Goto Exit_Function @@ -2227,7 +2227,7 @@ Public Function _getUpperShortcut(ByVal psShortcut As String, ByVal psLastCompon Else _getUpperShortcut = psShortcut End If - + End Function ' _getUpperShortcut REM ----------------------------------------------------------------------------------------------------------------------- @@ -2247,10 +2247,10 @@ Private Function _OpenObject(ByVal psObjectType As String _ Dim oDatabase As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable - + Dim sObjects() As String, sObjectName As String, oController As Object, oObject As Object Dim i As Integer, bFound As Boolean, lComponent As Long, oQuery As Object - + ' Check existence of object and find its exact (case-sensitive) name Select Case psObjectType Case "Table" @@ -2282,7 +2282,7 @@ Dim i As Integer, bFound As Boolean, lComponent As Long, oQuery As Object End If Set oController = oDatabase.Document.CurrentController Set oObject = oController.loadComponent(lComponent, sObjectName, ( pvView = acViewDesign )) - _OpenObject = True + _OpenObject = True Exit_Function: Set oObject = Nothing @@ -2335,7 +2335,7 @@ Dim oDialog As Object, iOKCancel As Integer, oControl As Object oControl.Text = "" oControl.StringItemList = Array() End If - + iOKCancel = oDialog.Execute() Select Case iOKCancel Case 1 ' OK @@ -2347,7 +2347,7 @@ Dim oDialog As Object, iOKCancel As Integer, oControl As Object oDialog.Dispose() End Function ' _PromptFormat V0.8.5 - + REM ----------------------------------------------------------------------------------------------------------------------- Public Function _SelectWindow(Optional ByVal piWindowType As Integer, Optional ByVal psWindow As String) As Object ' No argument: find active window @@ -2445,7 +2445,7 @@ Dim vPersistent As Variant, oForm As Object Select Case sImplementation Case "org.openoffice.comp.dbu.OTableDesign" : iType = acTable Case "org.openoffice.comp.dbu.OQueryDesign" : iType = acQuery - End Select + End Select sName = Right(oComp.Title, Len(psWindow)) End If Else @@ -2486,7 +2486,7 @@ Dim vPersistent As Variant, oForm As Object Exit Do End If Loop - + If bFound Then Set oWindow.Frame = oFrame oWindow._Name = sName @@ -2495,7 +2495,7 @@ Dim vPersistent As Variant, oForm As Object Else Set oWindow.Frame = Nothing End If - + Exit_Function: Set _SelectWindow = oWindow Exit Function @@ -2518,7 +2518,7 @@ Private Function _SendWithAttachment( _ ' Send message with attachments If _ErrorHandler() Then On Local Error Goto Error_Function _SendWithAttachment = False - + Const cstWindows = 1 Const cstLinux = 4 Const cstSemiColon = ";" @@ -2599,7 +2599,7 @@ Dim vCc() As Variant, i As Integer, iOS As Integer, sProduct As String, bMailPro End If _SendWithAttachment = True - + Exit_Function: Exit Function Error_Function: @@ -2626,7 +2626,7 @@ Const cstComma = "," If UBound(pvTo) >= 0 Then sTo = Trim(Join(pvTo, cstComma)) Else sTo = "" If UBound(pvCc) >= 0 Then sCc = Trim(Join(pvCc, cstComma)) Else sCc = "" If UBound(pvBcc) >= 0 Then sBcc = Trim(Join(pvBcc, cstComma)) Else sBcc = "" - + sMailTo = "mailto:" _ & sTo & "?" _ & Iif(sCc = "", "", "cc=" & sCc & "&") _ @@ -2635,7 +2635,7 @@ Const cstComma = "," & Iif(psBody = "", "", "body=" & psBody & "&") If Right(sMailTo, 1) = "&" Or Right(sMailTo, 1) = "?" Then sMailTo = Left(sMailTo, Len(sMailTo) - 1) sMailTo = ConvertToUrl(sMailTo) - + oDispatch = createUnoService( "com.sun.star.frame.DispatchHelper") oDispatch.executeDispatch(StarDesktop, sMailTo, "", 0, Array()) @@ -2659,4 +2659,4 @@ Dim oShell As Object End Sub ' _ShellExecute V0.8.5 -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba index eb314ea276ec..7242c605bc19 100644 --- a/wizards/source/access2base/Utils.xba +++ b/wizards/source/access2base/Utils.xba @@ -38,16 +38,16 @@ Dim i As Integer, vNewList() As Variant, vNumeric() As Variant, iSize As Integer Else vNewList = Array(pvTypes) End If - + vNumeric = Array(vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal, vbBoolean) - + iSize = UBound(vNewlist) ReDim Preserve vNewList(iSize + UBound(vNumeric) + 1) For i = 0 To UBound(vNumeric) vNewList(iSize + i + 1) = vNumeric(i) Next i - - _AddNumeric = vNewList + + _AddNumeric = vNewList End Function ' _AddNumeric V0.8.0 @@ -104,7 +104,7 @@ Public Function _CheckArgument(pvItem As Variant _ ' pvError If True (default), error handling in this routine. False in _setProperty methods in class modules. _CheckArgument = False - + Dim iVarType As Integer, bValidIsMissing As Boolean If IsArray(pvType) Then iVarType = VarType(pvType(LBound(pvType))) Else iVarType = VarType(pvType) If iVarType = vbString Then ' pvType is a pseudo-type string @@ -114,7 +114,7 @@ Dim iVarType As Integer, bValidIsMissing As Boolean If Not bValidIsMissing Then bValidIsMissing = IsMissing(pvValid) If bValidIsMissing Then _CheckArgument = Utils._IsScalar(pvItem, pvType) Else _CheckArgument = Utils._IsScalar(pvItem, pvType, pvValid) End If - + If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem) Exit_Function: @@ -201,12 +201,12 @@ Const cstByteLength = 25 Case Else : sArg = CStr(pvArg) End Select End If - If pbShort And Len(sArg) > cstLength Then + If pbShort And Len(sArg) > cstLength Then sLength = "(" & Len(sArg) & ")" sArg = Left(sArg, cstLength - 5 - Len(slength)) & " ... " & sLength End If _CStr = sArg - + End Function ' CStr V0.9.5 REM ----------------------------------------------------------------------------------------------------------------------- @@ -276,12 +276,12 @@ End Function REM ----------------------------------------------------------------------------------------------------------------------- Private Function _ExtensionLocation() As String ' Return the URL pointing to the location where OO installed the Access2Base extension -' Adapted from http://wiki.services.openoffice.org/wiki/Documentation/DevGuide/Extensions/Location_of_Installed_Extensions +' Adapted from https://wiki.documentfoundation.org/Documentation/DevGuide/Extensions#Location_of_Installed_Extensions Dim oPip As Object, sLocation As String Set oPip = GetDefaultContext.getByName("/singletons/com.sun.star.deployment.PackageInformationProvider") _ExtensionLocation = oPip.getPackageLocation("Access2Base") - + End Function ' ExtensionLocation REM ----------------------------------------------------------------------------------------------------------------------- @@ -289,7 +289,7 @@ Private Function _GetDialogLib() As Object ' Return actual Access2Base dialogs library Dim oDialogLib As Object - + Set oDialogLib = DialogLibraries If oDialogLib.hasByName("Access2BaseDev") Then If Not oDialogLib.IsLibraryLoaded("Access2BaseDev") Then oDialogLib.loadLibrary("Access2BaseDev") @@ -309,7 +309,7 @@ Public Function _GetEventName(ByVal psProperty As String) As String ' Corrects the typo on ErrorOccur(r?)ed _GetEventName = Replace(LCase(Mid(psProperty, 3, 1)) & Right(psProperty, Len(psProperty) - 3), "errorOccurred", "errorOccured") - + End Function ' _GetEventName V1.7.0 REM ----------------------------------------------------------------------------------------------------------------------- @@ -326,7 +326,7 @@ Dim i As Integer, vEvents As Variant, sEvent As String, oParent As Object, iInde _GetEventScriptCode = "" If Not Utils._hasUNOMethod(poObject, "getParent") Then Exit Function - ' Find form index i.e. find control via getByIndex() + ' Find form index i.e. find control via getByIndex() If IsMissing(pbExtendName) Then pbExtendName = False Set oParent = poObject.getParent() iIndex = -1 @@ -338,7 +338,7 @@ Dim i As Integer, vEvents As Variant, sEvent As String, oParent As Object, iInde End If Next i If iIndex < 0 Then Exit Function - + ' Find script event vEvents = oParent.getScriptEvents(iIndex) ' Returns an array sEvent = Utils._GetEventName(psEvent) ' Targeted event method @@ -360,7 +360,7 @@ REM Modified from Roberto Benitez's BaseTools REM get the data for the column specified by ColIndex REM If pbReturnBinary = False (default) then return length of binary field REM get type name from metadata - + Dim vValue As Variant, iType As Integer, vDateTime As Variant, oValue As Object Dim bNullable As Boolean, lSize As Long Const cstMaxTextLength = 65535 @@ -435,9 +435,9 @@ Const cstMaxBinlength = 2 * 65535 If poResultSet.wasNull() Then vValue = Null End If End With - + _GetResultSetColumnValue = vValue - + End Function ' GetResultSetColumnValue V 1.5.0 REM ----------------------------------------------------------------------------------------------------------------------- @@ -459,7 +459,7 @@ Dim sComponents() As String, sSubComponents() As String Case Else Exit Function End Select - + End Function ' FinalProperty REM ----------------------------------------------------------------------------------------------------------------------- @@ -512,14 +512,14 @@ End Function ' GetRegistryKeyContent V0.8.5 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _getTempDirectoryURL() As String ' Return the temporary directory defined in the OO Options (Paths) -Dim sDirectory As String, oSettings As Object, oPathSettings As Object +Dim sDirectory As String, oSettings As Object, oPathSettings As Object If _ErrorHandler() Then On Local Error Goto Error_Function - + _getTempDirectoryURL = "" oPathSettings = createUnoService( "com.sun.star.util.PathSettings" ) sDirectory = oPathSettings.GetPropertyValue( "Temp" ) - + _getTempDirectoryURL = sDirectory Exit_Function: @@ -583,9 +583,9 @@ Dim sObjectType As String On Local Error Resume Next sObjectType = pvObject.getImplementationName() If sObjectType = "" Then sObjectType = _getUNOTypeName(pvObject) - + _ImplementationName = sObjectType - + End Function ' ImplementationName REM ----------------------------------------------------------------------------------------------------------------------- @@ -645,9 +645,9 @@ Dim iTop As Integer, iBottom As Integer, iFound As Integer End If End If End If - - Exit Function - + + Exit Function + End Function ' InList V1.1.0 REM ----------------------------------------------------------------------------------------------------------------------- @@ -703,7 +703,7 @@ Public Function _IsPseudo(pvObject As Variant, ByVal pvType As Variant) As Boole Dim bIsPseudo As Boolean, bPseudoExists As Boolean, vObject As Variant If _ErrorHandler() Then On Local Error Goto Exit_False - + _IsPseudo = False bIsPseudo = False vObject = pvObject ' To avoid "Object variable not set" error message @@ -725,12 +725,12 @@ Dim bIsPseudo As Boolean, bPseudoExists As Boolean, vObject As Variant End Select End With End Select - + If Not bIsPseudo Then Goto Exit_Function - + Dim oDoc As Object, oForms As Variant Const cstSeparator = "\;" - + bPseudoExists = False With vObject Select Case ._Type @@ -784,7 +784,7 @@ Const cstSeparator = "\;" Case Else End Select End With - + _IsPseudo = ( bIsPseudo And bPseudoExists ) Exit_Function: @@ -812,9 +812,9 @@ Private Function _IsScalar(ByVal pvArg As Variant, ByVal pvType As Variant, ByVa If Not IsMissing(pvValid) Then If Not _InList(pvArg, pvValid) Then Exit Function End If - + _IsScalar = True - + Exit_Function: Exit Function End Function ' IsScalar V0.7.5 @@ -834,7 +834,7 @@ Dim vSubStrings() As Variant, i As Integer, iLen As Integer End If Next i _PCase = Join(vSubStrings, " ") - + End Function ' PCase V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- @@ -844,7 +844,7 @@ Private Function _PercentEncode(ByVal psChar As String) As String Dim lChar As Long, sByte1 As String, sByte2 As String, sByte3 As String lChar = Asc(psChar) - + Select Case lChar Case 48 To 57, 65 To 90, 97 To 122 ' 0-9, A-Z, a-z _PercentEncode = psChar @@ -868,7 +868,7 @@ Dim lChar As Long, sByte1 As String, sByte2 As String, sByte3 As String Case Else ' Not supported _PercentEncode = psChar End Select - + Exit Function End Function ' _PercentEncode V1.4.0 @@ -905,7 +905,7 @@ Const cstMaxLines = 16000 ' +/- the limit of array sizes in Basic Loop Close #iFile -Exit_Function: +Exit_Function: _ReadFileIntoArray() = vLines() Exit Function Error_Function: @@ -1009,7 +1009,7 @@ Dim i As Integer, oEvent As Object, sEvent As String, oParent As Object, iIndex _RegisterEventScript = False If Not _hasUNOMethod(poObject, "getParent") Then Exit Function - ' Find object internal index i.e. how to reach it via getByIndex() + ' Find object internal index i.e. how to reach it via getByIndex() If IsMissing(pbExtendName) Then pbExtendName = False Set oParent = poObject.getParent() iIndex = -1 @@ -1117,11 +1117,11 @@ Public Function _Trim(ByVal psString As String) As String Const cstSquareOpen = "[" Const cstSquareClose = "]" Dim sTrim As String - + sTrim = Trim(Replace(psString, vbTab, " ")) _Trim = sTrim If Len(sTrim) <= 2 Then Exit Function - + If Left(sTrim, 1) = cstSquareOpen Then If Right(sTrim, 1) = cstSquareClose Then _Trim = Mid(sTrim, 2, Len(sTrim) - 2) @@ -1172,7 +1172,7 @@ Private Function _UpdateResultSetColumnValue(piRDBMS As Integer _ ) As Boolean REM store the pvValue for the column specified by ColIndex REM get type name from metadata - + Dim iType As Integer, vDateTime As Variant, oValue As Object Dim bNullable As Boolean, lSize As Long, iValueType As Integer, sValueTypeName As String Const cstMaxTextLength = 65535 @@ -1234,9 +1234,9 @@ Const cstMaxBinlength = 2 * 65535 End If End With - + _UpdateResultSetColumnValue = True - + End Function ' UpdateResultSetColumnValue V 1.6.0 REM ----------------------------------------------------------------------------------------------------------------------- @@ -1276,7 +1276,7 @@ Dim lCurrentChar As Long, bQuestionMark As Boolean End If End Select Next lCurrentChar - + _URLEncode = sEncoded End Function ' _URLEncode V1.4.0 @@ -1305,4 +1305,4 @@ Private Function _UTF8Encode(ByVal psChar As String) As String End Function ' _UTF8Encode V1.4.0 -</script:module> +</script:module>
\ No newline at end of file |