REM ======================================================================================================================= REM === The Access2Base library is a part of the LibreOffice project. === REM === Full documentation is available on http://www.access2base.com === REM ======================================================================================================================= Option Explicit Global _A2B_ As Variant REM ----------------------------------------------------------------------------------------------------------------------- REM --- PRIVATE FUNCTIONS --- REM ----------------------------------------------------------------------------------------------------------------------- Public Function _AddNumeric(ByVal Optional pvTypes As Variant) As Variant 'Return on top of argument the list of all numeric types 'Facilitates the entry of the list of allowed types in _CheckArgument calls Dim i As Integer, vNewList() As Variant, vNumeric() As Variant, iSize As Integer If IsMissing(pvTypes) Then vNewList = Array() ElseIf IsArray(pvTypes) Then vNewList = pvTypes Else vNewList = Array(pvTypes) End If vNumeric = Array(vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal) 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 End Function ' _AddNumeric V0.8.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _BitShift(piValue As Integer, piConstant As Integer) As Boolean _BitShift = False If piValue = 0 Then Exit Function Select Case piConstant Case 1 Select Case piValue Case 1, 3, 5, 7, 9, 11, 13, 15: _BitShift = True Case Else End Select Case 2 Select Case piValue Case 2, 3, 6, 7, 10, 11, 14, 15: _BitShift = True Case Else End Select Case 4 Select Case piValue Case 4, 5, 6, 7, 12, 13, 14, 15: _BitShift = True Case Else End Select Case 8 Select Case piValue Case 8, 9, 10, 11, 12, 13, 14, 15: _BitShift = True Case Else End Select End Select End Function ' BitShift REM ----------------------------------------------------------------------------------------------------------------------- Public Function _CalledSub() As String _CalledSub = Iif(_A2B_.CalledSub = "", "", _GetLabel("CALLTO") & " '" & _A2B_.CalledSub & "'") End Function ' CalledSub V0.8.9 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _CheckArgument(pvItem As Variant _ , ByVal piArgNr As Integer _ , Byval pvType As Variant _ , ByVal Optional pvValid As Variant _ , ByVal Optional pvError As Boolean _ ) As Variant ' Called by public functions to check the validity of their arguments ' pvItem Argument to be checked ' piArgNr Argument sequence number ' pvType Single value or array of allowed variable types ' If of string type must contain one or more valid pseudo-object types ' pvValid Single value or array of allowed values - comparison for strings is case-insensitive ' pvError If True (default), error handling in this routine. False in _setProperty methods in class modules. _CheckArgument = False Dim iVarType As Integer If IsArray(pvType) Then iVarType = VarType(pvType(LBound(pvType))) Else iVarType = VarType(pvType) If iVarType = vbString Then ' pvType is a pseudo-type string _CheckArgument = Utils._IsPseudo(pvItem, pvType) Else If IsMissing(pvValid) 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: If Not _CheckArgument Then If IsMissing(pvError) Then pvError = True If pvError Then TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(piArgNr, pvItem)) End If End If Exit Function End Function ' CheckArgument V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _CStr(pvArg As Variant, ByVal Optional pbShort As Boolean) As String ' Convert pvArg into a readable string (truncated if too long and pbShort = True or missing) Dim sArg As String, sObject As String, oArg As Object, sLength As String Const cstLength = 50 If IsArray(pvArg) Then sArg = "[ARRAY]" Else Select Case VarType(pvArg) Case vbEmpty : sArg = "[EMPTY]" Case vbNull : sArg = "[NULL]" Case vbObject If IsNull(pvArg) Then sArg = "[NULL]" Else sObject = Utils._ImplementationName(pvArg) If Utils._IsPseudo(pvArg, Array(OBJDATABASE, OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _ , OBJEVENT, OBJFIELD, OBJTABLEDEF, OBJQUERYDEF, OBJRECORDSET _ )) Then Set oArg = pvArg ' To avoid "Object variable not set" error message sArg = "[" & oArg._Type & "] " & oArg._Name ElseIf sObject <> "" Then sArg = "[" & sObject & "]" Else sArg = "[OBJECT]" End If End If Case vbVariant : sArg = "[VARIANT]" Case vbString : sArg = pvArg Case vbBoolean : sArg = Iif(pvArg, "TRUE", "FALSE") Case Else : sArg = CStr(pvArg) End Select End If If IsMissing(pbShort) Then pbShort = True 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 ----------------------------------------------------------------------------------------------------------------------- Public Function _DecimalPoint() As String 'Return locale decimal point _DecimalPoint = Mid(Format(0, "0.0"), 2, 1) 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 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 ----------------------------------------------------------------------------------------------------------------------- Private Function _getResultSetColumnValue(poResultSet As Object, Byval piColIndex As Integer) As Variant REM Modified from Roberto Benitez's BaseTools REM get the data for the column specified by ColIndex REM get type name from metadata Dim vValue As Variant, sType As String, vDateTime As Variant sType = poResultSet.MetaData.getColumnTypeName(piColIndex) Select Case sType Case "ARRAY": vValue = poResultSet.getArray(piColIndex) Case "BLOB": vValue = poResultSet.getBlob(piColIndex) Case "BIT", "BOOLEAN": vValue = poResultSet.getBoolean(piColIndex) Case "BYTE": vValue = poResultSet.getByte(piColIndex) Case "BYTES": vValue = poResultSet.getBytes(piColIndex) Case "CLOB": vValue = poResultSet.getClob(piColIndex) Case "DATE": vDateTime = poResultSet.getDate(piColIndex) vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) Case "DOUBLE", "REAL": vValue = poResultSet.getDouble(piColIndex) Case "FLOAT": vValue = poResultSet.getFloat(piColIndex) Case "INTEGER", "SMALLINT": vValue = poResultSet.getInt(piColIndex) Case "LONG", "BIGINT": vValue = poResultSet.getLong(piColIndex) Case "DECIMAL", "NUMERIC": vValue = poResultSet.getDouble(piColIndex) Case "NULL": vValue = poResultSet.getNull(piColIndex) Case "OBJECT": vValue = poResultSet.getObject(piColIndex) Case "REF": vValue = poResultSet.getRef(piColIndex) Case "SHORT", "TINYINT": vValue = poResultSet.getShort(piColIndex) Case "CHAR", "VARCHAR", "LONGVARCHAR": vValue = poResultSet.getString(piColIndex) Case "TIME": vDateTime = poResultSet.getTime(piColIndex) vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)', vDateTime.HundredthSeconds) Case "TIMESTAMP": vDateTime = poResultSet.getTimeStamp(piColIndex) vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _ + TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)', vDateTime.HundredthSeconds) Case Else vValue = poResultSet.getString(piColIndex) 'GIVE STRING A TRY If IsNumeric(vValue) Then vValue = Val(vValue) 'Required when type = "", sometimes numeric fields are returned as strings (query/MSAccess) End Select _getResultSetColumnValue = vValue End Function ' getResultSetColumnValue V 0.9.5 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _FinalProperty(psShortcut As String) As String ' Return the final property of a shortcut Const cstEXCLAMATION = "!" Const cstDOT = "." Dim iCurrentIndex As Integer, vCurrentObject As Variant, sCurrentProperty As String Dim sComponents() As String, sSubComponents() As String _FinalProperty = "" sComponents = Split(Trim(psShortcut), cstEXCLAMATION) If UBound(sComponents) = 0 Then Exit Function sSubComponents = Split(sComponents(UBound(sComponents)), cstDOT) Select Case UBound(sSubComponents) Case 1 _FinalProperty = sSubComponents(1) Case Else Exit Function End Select End Function ' FinalProperty REM ----------------------------------------------------------------------------------------------------------------------- Public Function _GetProductName(ByVal Optional psFlag As String) as String 'Return OO product ("PRODUCT") and version numbers ("VERSION") 'Derived from Tools library Dim oProdNameAccess as Object Dim sVersion as String Dim sProdName as String If IsMissing(psFlag) Then psFlag = "ALL" oProdNameAccess = _GetRegistryKeyContent("org.openoffice.Setup/Product") sProdName = oProdNameAccess.getByName("ooName") sVersion = oProdNameAccess.getByName("ooSetupVersionAboutBox") Select Case psFlag Case "ALL" : _GetProductName = sProdName & " " & sVersion Case "PRODUCT" : _GetProductName = sProdName Case "VERSION" : _GetProductName = sVersion End Select End Function ' GetProductName V1.0.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean) As Variant 'Implement ConfigurationProvider service 'Derived from Tools library Dim oConfigProvider as Object Dim aNodePath(0) as new com.sun.star.beans.PropertyValue oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider") aNodePath(0).Name = "nodepath" aNodePath(0).Value = sKeyName If IsMissing(bForUpdate) Then bForUpdate = False If bForUpdate Then _GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", aNodePath()) Else _GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath()) End If End Function ' GetRegistryKeyContent V0.8.5 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _getUNOTypeName(pvObject As Variant) As String ' Return the symbolic name of the pvObject (UNO-object) type ' Code-snippet from XRAY Dim oService As Object, vClass as Variant _getUNOTypeName = "" On Local Error Resume Next oService = CreateUnoService("com.sun.star.reflection.CoreReflection") vClass = oService.getType(pvObject) If vClass.TypeClass = com.sun.star.uno.TypeClass.STRUCT Then _getUNOTypeName = vClass.Name End If oService.Dispose() End Function ' getUNOTypeName REM ----------------------------------------------------------------------------------------------------------------------- Public Function _hasUNOMethod(pvObject As Variant, psMethod As String) As Boolean ' Return true if pvObject has the (UNO) method psMethod ' Code-snippet found in Bernard Marcelly's XRAY Dim vInspect as Variant _hasUNOMethod = False On Local Error Resume Next If IsNull(_A2B_.Introspection) Then _A2B_.Introspection = CreateUnoService("com.sun.star.beans.Introspection") vInspect = _A2B_.Introspection.Inspect(pvObject) _hasUNOMethod = vInspect.hasMethod(psMethod, com.sun.star.beans.MethodConcept.ALL) End Function ' hasUNOMethod V0.8.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _hasUNOProperty(pvObject As Variant, psProperty As String) As Boolean ' Return true if pvObject has the (UNO) property psProperty ' Code-snippet found in Bernard Marcelly's XRAY Dim vInspect as Variant _hasUNOProperty = False On Local Error Resume Next If IsNull(_A2B_.Introspection) Then _A2B_.Introspection = CreateUnoService("com.sun.star.beans.Introspection") vInspect = _A2B_.Introspection.Inspect(pvObject) _hasUNOProperty = vInspect.hasProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL) End Function ' hasUNOProperty V0.8.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _ImplementationName(pvObject As Variant) As String ' Use getImplementationName method or _getUNOTypeName function Dim sObjectType As String On Local Error Resume Next sObjectType = pvObject.getImplementationName() If sObjectType = "" Then sObjectType = _getUNOTypeName(pvObject) _ImplementationName = sObjectType End Function ' ImplementationName REM ----------------------------------------------------------------------------------------------------------------------- Public Function _InList(ByVal pvItem As Variant, pvList As Variant, ByVal Optional pvReturnValue As Variant, Optional ByVal pbBinarySearch As Boolean) As Variant ' Return True if pvItem is present in the pvList array (case insensitive comparison) ' Return the value in pvList if pvReturnValue = True Dim i As Integer, bFound As Boolean, iListVarType As Integer, iItemVarType As Integer Dim iTop As Integer, iBottom As Integer, iFound As Integer iItemVarType = VarType(pvItem) If iItemVarType = vbNull Or IsNull(pvList) Then _InList = False ElseIf Not IsArray(pvList) Then _InList = ( pvItem = pvList ) ElseIf UBound(pvList) < LBound(pvList) Then ' Array not initialized _InList = False Else bFound = False _InList = False iListVarType = VarType(pvList(LBound(pvList))) If iListVarType = iItemVarType _ Or ( (iListVarType = vbInteger Or iListVarType = vbLong Or iListVarType = vbSingle Or iListVarType = vbDouble _ Or iListVarType = vbCurrency Or iListVarType = vbBigint Or iListVarType = vbDecimal) _ And (iItemVarType = vbInteger Or iItemVarType = vbLong Or iItemVarType = vbSingle Or iItemVarType = vbDouble _ Or iItemVarType = vbCurrency Or iItemVarType = vbBigint Or iItemVarType = vbDecimal) _ ) Then If IsMissing(pbBinarySearch) Then pbBinarySearch = False If Not pbBinarySearch Then ' Linear search For i = LBound(pvList) To UBound(pvList) If iItemVarType = vbString Then bFound = ( pvList(i) <> "" And UCase(pvItem) = UCase(pvList(i)) ) Else bFound = ( pvItem = pvList(i) ) If bFound Then iFound = i Exit For End If Next i Else ' Binary search => array must be sorted iTop = UBound(pvList) iBottom = lBound(pvList) Do iFound = (iTop + iBottom) / 2 If ( iItemVarType = vbString And UCase(pvItem) > UCase(pvList(iFound)) ) Or ( iItemVarType <> vbString And pvItem > pvList(iFound) ) Then iBottom = iFound + 1 Else iTop = iFound - 1 End If If iItemVarType = vbString Then bFound = ( pvList(i) <> "" And UCase(pvItem) = UCase(pvList(iFound)) ) Else bFound = ( pvItem = pvList(iFound) ) Loop Until ( bFound ) Or ( iBottom > iTop ) End If If bFound Then If IsMissing(pvReturnValue) Then _InList = True Else _InList = pvList(iFound) End If End If End If Exit Function End Function ' InList V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _InspectPropertyType(poObject As Object, psProperty As String) As String 'Return type of property EVEN WHEN EMPTY ! (Used in date and time controls) Dim oInspect1 As Object, oInspect2 As Object, oInspect3 As Object ' On Local Error Resume Next _InspectPropertyType = "" Set oInspect1 = CreateUnoService("com.sun.star.script.Invocation") Set oInspect2 = oInspect1.createInstanceWithArguments(Array(poObject)).IntroSpection If Not IsNull(oInspect2) Then Set oInspect3 = oInspect2.getProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL) If Not IsNull(oInspect3) Then _InspectPropertyType = oInspect3.Type.Name End If Set oInspect1 = Nothing : Set oInspect2 = Nothing : Set oInspect3 = Nothing End Function ' InspectPropertyType V1.0.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _IsPseudo(pvObject As Variant, ByVal pvType As Variant) As Boolean ' Test pvObject: does it exist ? ' is the _Type item = one of the proposed pvTypes ? ' does the pseudo-object refer to an existing object (e.g. does the form really exist in the db) ? 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 Select Case True Case IsEmpty(vObject) Case IsNull(vObject) Case VarType(vObject) <> vbObject Case Else With vObject Select Case True Case IsEmpty(._Type) Case IsNull(._Type) Case ._Type = "" Case Else bIsPseudo = _InList(._Type, pvType) If Not bIsPseudo Then ' If primary type did not succeed, give the subtype a chance If ._Type = OBJCONTROL Then bIsPseudo = _InList(._SubType, pvType) End If End Select End With End Select If Not bIsPseudo Then Goto Exit_Function Dim oDatabase As Variant, oForms As Variant bPseudoExists = False With vObject Select Case ._Type Case OBJFORM If ._Name <> "" Then ' Check validity of form name Set oDatabase = _CurrentDb If oDatabase._Standalone Then bPseudoExists = True Else Set oForms = oDatabase.Document.getFormDocuments() bPseudoExists = ( oForms.HasByName(._Name) ) End If End If Case OBJDATABASE If ._Standalone Then bPseudoExists = True Else bPseudoExists = .Document.CurrentController.IsConnected Case OBJDIALOG If ._Name <> "" Then ' Check validity of dialog name Set oDatabase = _CurrentDb bPseudoExists = ( oDatabase._hasDialog(._Name) ) End If Case OBJCOLLECTION bPseudoExists = True Case OBJCONTROL If Not IsNull(.ControlModel) And ._Name <> "" Then ' Check validity of control Set oForms = .ControlModel.Parent bPseudoExists = ( oForms.hasByName(._Name) ) End If Case OBJSUBFORM If Not IsNull(.DatabaseForm) And ._Name <> "" Then ' Check validity of subform If .DatabaseForm.ImplementationName = "com.sun.star.comp.forms.ODatabaseForm" Then Set oForms = .DatabaseForm.Parent bPseudoExists = ( oForms.hasByName(._Name) ) End If End If Case OBJOPTIONGROUP bPseudoExists = ( .Count > 0 ) Case OBJEVENT bPseudoExists = ( Not IsNull(._EventSource) ) Case OBJPROPERTY bPseudoExists = ( ._Name <> "" ) Case OBJTABLEDEF bPseudoExists = ( ._Name <> "" And Not IsNull(.Table) ) Case OBJQUERYDEF bPseudoExists = ( ._Name <> "" And Not IsNull(.Query) ) Case OBJRECORDSET bPseudoExists = ( Not IsNull(.RowSet) ) Case OBJFIELD bPseudoExists = ( ._Name <> "" And Not IsNull(.Column) ) Case Else End Select End With _IsPseudo = ( bIsPseudo And bPseudoExists ) Exit_Function: Exit Function Exit_False: _IsPseudo = False Goto Exit_Function End Function ' IsPseudo V0.9.1 REM ----------------------------------------------------------------------------------------------------------------------- Private Function _IsScalar(ByVal pvArg As Variant, Byval pvType As Variant, ByVal Optional pvValid As Variant) As Boolean ' Check type of pvArg and value in allowed pvValid list _IsScalar = False If IsArray(pvType) Then If Not _InList(VarType(pvArg), pvType) Then Exit Function ElseIf VarType(pvArg) <> pvType Then If pvType = vbBoolean And VarType(pvArg) = vbLong Then If pvArg < -1 And pvArg > 0 Then Exit Function ' Special boolean processing because the Not function returns a Long Else Exit Function End If End If 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 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _PCase(ByVal psString As String) As String ' Return the proper case representation of argument Dim vSubStrings() As Variant, i As Integer, iLen As Integer vSubStrings = Split(psString, " ") For i = 0 To UBound(vSubStrings) iLen = Len(vSubStrings(i)) If iLen > 1 Then vSubStrings(i) = UCase(Left(vSubStrings(i), 1)) & LCase(Right(vSubStrings(i), iLen - 1)) ElseIf iLen = 1 Then vSubStrings(i) = UCase(vSubStrings(i)) End If Next i _PCase = Join(vSubStrings, " ") End Function ' PCase V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _ReplaceSquareBrackets(ByVal psSql As String) As String ' Returns psSql after substitution of [] by quote character ' [] square brackets in quoted strings not affected Dim sQuote As String 'RDBMS specific quote character Dim vSubStrings() As Variant, i As Integer sQuote = CurrentDb.MetaData.IdentifierQuoteString If sQuote = " " Then ' What's the string used to quote SQL identifiers? This returns a space " " if identifier quoting is not supported. _QuoteString = psSql Exit Function End If vSubStrings() = Split(psSql, sQuote) For i = 0 To UBound(vSubStrings) If (i Mod 2) = 0 Then ' Only even substrings are parsed for square brackets vSubStrings(i) = Join(Split(vSubStrings(i), "["), sQuote) vSubStrings(i) = Join(Split(vSubStrings(i), "]"), sQuote) End If Next i _ReplaceSquareBrackets = Join(vSubStrings, sQuote) End Function ' ReplaceSquareBrackets V0.7.5 REM ----------------------------------------------------------------------------------------------------------------------- Public Sub _ResetCalledSub(ByVal psSub As String) As String ' Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling ' Used to trace routine in/outs and to clarify error messages If _A2B_.CalledSub = psSub Then _A2B_.CalledSub = "" If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel("Exiting") & " " & psSub & " ...", False) End Sub ' ResetCalledSub REM ----------------------------------------------------------------------------------------------------------------------- Public Sub _SetCalledSub(ByVal psSub As String) As String ' Called in top of each public function. ' Used to trace routine in/outs and to clarify error messages If _A2B_.CalledSub = "" Then _A2B_.CalledSub = psSub If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel("Entering") & " " & psSub & " ...", False) End Sub ' SetCalledSub REM ----------------------------------------------------------------------------------------------------------------------- Public Function _Surround(ByVal psName As String) As String ' Return [Name] if Name contains spaces Const cstSquareOpen = "[" Const cstSquareClose = "]" If InStr(psName, " ") > 0 Then _Surround = cstSquareOpen & psName & cstSquareClose Else _Surround = psName End If End Function ' Surround REM ----------------------------------------------------------------------------------------------------------------------- Public Function _Trim(ByVal psString As String) As String ' Remove leading and trailing spaces, remove surrounding square brackets Const cstSquareOpen = "[" Const cstSquareClose = "]" Dim sTrim As String sTrim = Trim(psString) _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) End If End If End Function ' Trim V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _TrimArray(pvArray As Variant) As Variant ' Remove empty strings from strings array Dim sTrim As String, vTrim() As Variant, i As Integer, j As Integer, iCount As Integer vTrim = Null If Not IsArray(pvArray) Then If Len(Trim(pvArray)) > 0 Then vTrim = Array(pvArray) Else vTrim = Array() ElseIf UBound(pvArray) < LBound(pvArray) Then ' Array empty vTrim = Array() Else iCount = 0 For i = LBound(pvArray) To UBound(pvArray) If Len(Trim(pvArray(i))) = 0 Then iCount = iCount + 1 Next i If iCount = 0 Then vTrim() = pvArray() ElseIf iCount = UBound(pvArray) - LBound(pvArray) + 1 Then ' Array empty or all blanks vTrim() = Array() Else ReDim vTrim(LBound(pvArray) To UBound(pvArray) - iCount) j = 0 For i = LBound(pvArray) To UBound(pvArray) If Len(Trim(pvArray(i))) > 0 Then vTrim(j) = pvArray(i) j = j + 1 End If Next i End If End If _TrimArray() = vTrim() End Function ' TrimArray V0.9.0