diff options
author | Jean-Pierre Ledure <jp@ledure.be> | 2018-08-13 17:54:21 +0200 |
---|---|---|
committer | Jean-Pierre Ledure <jp@ledure.be> | 2018-08-13 18:05:43 +0200 |
commit | 83709f8af41c7ec7bcd727b8001d84a9e67c1e55 (patch) | |
tree | 8be9598002faf24c6aa9ce5fb99cb665ba849e0e | |
parent | 690cbe7aa2d36373e93a8d50da4a1d026f9e56bd (diff) |
Access2Base - Support hierarchical form names
So far, only a flat list of form names was implemented (by far the majority of cases).
Now, hierarchical form names (like "Folder1/Folder2/myForm") are accepted.
Impacts:
- on AllForms() and Forms() collections:
- insertion of _GetAllHierarchicalNames() to make list of names
- insertion of _CollectNames(): recursive function to walk thru folders
- insertion of _GetHierarchicalName(persistent name) to establist correspondence
- on OpenForm action
- on SelectObject action: form windows are not identified by title anymore
- on form and control events
- on arguments check when argument is a form object
Change-Id: I2da73ac3d4fe2d90b2e526fe510207c0f8ec8386
-rw-r--r-- | wizards/source/access2base/Application.xba | 151 | ||||
-rw-r--r-- | wizards/source/access2base/DoCmd.xba | 16 | ||||
-rw-r--r-- | wizards/source/access2base/Event.xba | 23 | ||||
-rw-r--r-- | wizards/source/access2base/Form.xba | 35 | ||||
-rw-r--r-- | wizards/source/access2base/Methods.xba | 2 | ||||
-rw-r--r-- | wizards/source/access2base/PropertiesGet.xba | 2 | ||||
-rw-r--r-- | wizards/source/access2base/Root_.xba | 4 | ||||
-rw-r--r-- | wizards/source/access2base/Utils.xba | 8 |
8 files changed, 173 insertions, 68 deletions
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba index 82c9defca7fc..970e7f6b1884 100644 --- a/wizards/source/access2base/Application.xba +++ b/wizards/source/access2base/Application.xba @@ -184,6 +184,12 @@ Type DbContainer End Type REM ----------------------------------------------------------------------------------------------------------------------- +REM --- Next variable is initialized to empty at each macro execution start --- +REM --- Items in both lists correspond one by one --- +Public vFormNamesList As Variant ' (0) Buffer of hierarchical form names => "\;" separated values + ' (1) Buffer of persistent form names => "\;" separated values + +REM ----------------------------------------------------------------------------------------------------------------------- Public Function AllDialogs(ByVal Optional pvIndex As Variant) As Variant ' Return either a Collection or a Dialog object ' The dialogs are selected only if library is loaded @@ -322,57 +328,61 @@ Public Function AllForms(ByVal Optional pvIndex As Variant) As Variant ' Easiest use for standalone forms: AllForms(0) ' If no argument, return a Collection type - If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "AllForms" +Dim iIndex As Integer, vReturn As Variant +Dim iCurrentDoc As Integer, vCurrentDoc As Variant, oForms As Variant, oCounter As Variant, oFormsCollection As Object +Dim ofForm As Object +Dim vAllForms As Variant, i As Integer, vName As Variant, oDatabase As Object, bFound As Boolean +Const cstSeparator = "\;" + + If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub(cstThisSub) -Dim iIndex As Integer, vAllForms As Variant - Set vAllForms = Nothing + Set vReturn = Nothing If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function Select Case VarType(pvIndex) Case vbString iIndex = -1 - Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal + Case Else iIndex = pvIndex End Select End If -Dim iCurrentDoc As Integer, vCurrentDoc As Variant, oForms As Variant, oCounter As Variant, oFormsCollection As Object iCurrentDoc = _A2B_.CurrentDocIndex() If iCurrentDoc >= 0 Then vCurrentDoc = _A2B_.CurrentDocument(iCurrentDoc) Else Goto Exit_Function End If - If vCurrentDoc.DbConnect = DBCONNECTBASE Then Set oForms = vCurrentDoc.Document.getFormDocuments() + +' Load complete list of hierarchical and persistent names when Base document + If vCurrentDoc.DbConnect = DBCONNECTBASE Then vAllForms = _GetAllHierarchicalNames() + ' Process when NO ARGUMENT If IsMissing(pvIndex) Then ' No argument Set oCounter = New Collect oCounter._CollType = COLLALLFORMS oCounter._ParentType = OBJAPPLICATION oCounter._ParentName = "" - If vCurrentDoc.DbConnect = DBCONNECTFORM Then oCounter._Count = UBound(vCurrentDoc.DbContainers) + 1 Else oCounter._Count = oForms.getCount() - Set vAllForms = oCounter + If vCurrentDoc.DbConnect = DBCONNECTFORM Then oCounter._Count = UBound(vCurrentDoc.DbContainers) + 1 Else oCounter._Count = UBound(vAllForms) + 1 + Set vReturn = oCounter Goto Exit_Function End If ' Process when ARGUMENT = STRING or INDEX => Initialize form object -Dim ofForm As Object Set ofForm = New Form -Dim sAllForms As Variant, i As Integer, vName As Variant, oDatabase As Object, bFound As Boolean Select Case vCurrentDoc.DbConnect Case DBCONNECTBASE - sAllForms() = oForms.getElementNames() ofForm._DocEntry = 0 ofForm._DbEntry = 0 If iIndex= -1 Then ' String argument - vName = Utils._InList(Utils._Trim(pvIndex), sAllForms, True) ' hasByName not used because case sensitive + vName = Utils._InList(Utils._Trim(pvIndex), vAllForms, True) If vName = False Then Goto Trace_Not_Found ofForm._Initialize(vName) Else - If iIndex + 1 > oForms.getCount() Or iIndex < 0 Then Goto Trace_Error_Index ' Numeric argument OK but value nonsense - ofForm._Initialize(sAllForms(iIndex)) + If iIndex > UBound(vAllForms) Or iIndex < 0 Then Goto Trace_Error_Index ' Numeric argument OK but value nonsense + ofForm._Initialize(vAllForms(iIndex)) End If Case DBCONNECTFORM With vCurrentDoc @@ -399,10 +409,10 @@ Dim sAllForms As Variant, i As Integer, vName As Variant, oDatabase As Object, b ofForm._Initialize(vName) End Select - Set vAllForms = ofForm + Set vReturn = ofForm Exit_Function: - Set AllForms = vAllForms + Set AllForms = vReturn Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Not_Found: @@ -410,11 +420,11 @@ Trace_Not_Found: Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) - Set vAllForms = Nothing + Set vReturn = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) - Set vAllForms = Nothing + Set vReturn = Nothing GoTo Exit_Function End Function ' AllForms V0.9.0 @@ -1031,11 +1041,10 @@ Dim iCount As Integer Select Case VarType(pvIndex) Case vbString Set ofForm = Application.AllForms(Utils._Trim(pvIndex)) - Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal + Case Else iCount = Application._CountOpenForms() If iCount <= pvIndex Then Goto Trace_Error_Index Set ofForm = Application._CountOpenForms(pvIndex) - Case Else End Select If IsNull(ofForm) Then Goto Trace_Error @@ -1525,6 +1534,53 @@ REM --- PRIVATE FUNCTIONS --- REM ----------------------------------------------------------------------------------------------------------------------- REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _CollectNames(ByRef poCollection As Object, ByVal psPrefix As String) As Variant +' Return a "\;" speparated list of hierarchical (prefixed with Prefix) and persistent names contained in Collection +' If one of those names refers to a folder, function is called recursively +' Result = 2 items array: (0) list of hierarchical names +' (1) list of persistent names +' +Dim oObject As Object, vNamesList() As Variant, vPersistentList As Variant, i As Integer, vCollect As Variant +Dim sName As String, sType As String, sPrefix As String +Const cstFormType = "application/vnd.oasis.opendocument.text" +Const cstSeparator = "\;" + + _CollectNames = Array() + vCollect = Array() + ReDim vCollect(0 To 1) + vPersistentList = Array() + + With poCollection + If .getCount = 0 Then Exit Function + vNamesList = .getElementNames() + ReDim vPersistentList(0 To UBound(vNamesList)) + + For i = 0 To UBound(vNamesList) + sName = vNamesList(i) + Set oObject = .getByName(sName) + sType = oObject.getContentType() + Select Case sType + Case cstFormType + vNamesList(i) = psPrefix & vNamesList(i) + vPersistentList(i) = oObject.PersistentName + Case "" ' Folder + vCollect = _CollectNames(oObject, psPrefix & sName & "/") + vNamesList(i) = vCollect(0) + vPersistentList(i) = vCollect(1) + Case Else + End Select + Next i + + End With + + Set oObject = Nothing + vCollect(0) = Join(vNamesList, cstSeparator) + vCollect(1) = Join(vPersistentList, cstSeparator) + _CollectNames = vCollect + +End Function ' _CollectNames V6.2.0 + +REM ----------------------------------------------------------------------------------------------------------------------- Public Function _CountOpenForms(ByVal Optional piCountMax As Integer) As Variant ' Return # of active forms if no argument ' Return name of piCountMax-th open form if argument present @@ -1535,7 +1591,7 @@ Dim i As Integer, iCount As Integer, iAllCount As Integer, ofForm As Variant If iAllCount > 0 Then For i = 0 To iAllCount - 1 Set ofForm = Application.AllForms(i) - If ofForm.IsLoaded Then iCount = iCount + 1 + If ofForm._IsLoaded Then iCount = iCount + 1 If Not IsMissing(piCountMax) Then If iCount = piCountMax + 1 Then _CountOpenForms = ofForm ' OO3.2 aborts when Set verb present ?!? @@ -1568,6 +1624,59 @@ Trace_Error: End Function ' _CurrentDb V1.1.0 REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _GetAllHierarchicalNames() As Variant +' Return the full hierarchical names list of a database document +' Get it from the vFormNamesList buffer if the latter is not empty + +Dim vNamesList As Variant, iCurrentDoc As Integer, vCurrentDoc As Variant +Dim oForms As Object +Const cstSeparator = "\;" + + _GetAllHierarchicalNames = Array() + +' Load complete list of names when Base document + iCurrentDoc = _A2B_.CurrentDocIndex() + If iCurrentDoc >= 0 Then vCurrentDoc = _A2B_.CurrentDocument(iCurrentDoc) Else Exit Function + If vCurrentDoc.DbConnect = DBCONNECTBASE Then + If IsEmpty(vFormNamesList) Then + Set oForms = vCurrentDoc.Document.getFormDocuments() + vFormNamesList = _CollectNames(oForms, "") + End If + vNamesList = Split(vFormNamesList(0), cstSeparator) + Else + Exit Function + End If + + _GetAllHierarchicalNames = vNamesList + Set oForms = Nothing + +End Function ' _GetAllHierarchicalNames V 6.2.0 + +REM ----------------------------------------------------------------------------------------------------------------------- +Private Function _GetHierarchicalName(ByVal psPersistent As String) As String +' Return the full hierarchical name from the persistent name of a form/report + +Dim vPersistentList As Variant, vNamesList As Variant, i As Integer +Const cstSeparator = "\;" + + _GetHierarchicalName = "" + +' Load complete list of names when Base document + vNamesList = _GetAllHierarchicalNames() + If UBound(vNamesList) < 0 Then Exit Function + vPersistentList = Split(vFormNamesList(1), cstSeparator) + +' Search in list + For i = 0 To UBound(vPersistentList) + If vPersistentList(i) = psPersistent Then + _GetHierarchicalName = vNamesList(i) + Exit For + End If + Next i + +End Function ' _GetHierarchicalName V 6.2.0 + +REM ----------------------------------------------------------------------------------------------------------------------- Private Function _NewBar() As Object ' Close current status bar, if any, and initialize new one diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba index 25ddc89352da..161b544a87fe 100644 --- a/wizards/source/access2base/DoCmd.xba +++ b/wizards/source/access2base/DoCmd.xba @@ -125,7 +125,7 @@ Dim oDatabase As Object ' Check existence of object and find its exact (case-sensitive) name Select Case pvObjectType Case acForm - sObjects = oDatabase.Document.getFormDocuments.ElementNames() + sObjects = Application._GetAllHierarchicalNames() lComponent = com.sun.star.sdb.application.DatabaseObject.FORM Case acTable sObjects = oDatabase.Connection.getTables.ElementNames() @@ -149,7 +149,7 @@ Dim oDatabase As Object Select Case pvObjectType Case acForm - Set oController = oDatabase.Document.getFormDocuments.getByName(sObjectName) + Set oController = oDatabase.Document.getFormDocuments.getByHierarchicalName(sObjectName) mClose = oController.close() Case acTable, acQuery ' Not optimal but it works !! Set oController = oDatabase.Document.CurrentController @@ -1140,6 +1140,8 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object Else sFilter = "(" & pvFilterName & ") And (" & pvWhereCondition & ")" End If + Set oFormsCollection = oOpenForm.DrawPage.Forms + If oFormsCollection.getCount() > 0 Then Set oForm = oFormsCollection.getByIndex(0) Else Set oForm = Nothing If Not IsNull(oForm) Then If sFilter <> "" Then oForm.Filter = oDatabase._ReplaceSquareBrackets(sFilter) @@ -1174,7 +1176,7 @@ Dim sFilter As String, oForm As Object, oFormsCollection As Object End If .Visible = ( pvWindowMode <> acHidden ) ._OpenArgs = pvOpenArgs - 'To avoid AOO 3,4 bug See http://user.services.openoffice.org/en/forum/viewtopic.php?f=13&t=53751 + 'To avoid AOO 3.4 bug See http://user.services.openoffice.org/en/forum/viewtopic.php?f=13&t=53751 .Component.CurrentController.ViewSettings.ShowOnlineLayout = True End With @@ -2355,6 +2357,7 @@ Dim oEnum As Object, oDesk As Object, oComp As Object, oFrame As Object, i As In Dim bFound As Boolean, bActive As Boolean, sName As String, iType As Integer, sDocumentType As String Dim sImplementation As String, vLocation() As Variant Dim oWindow As _Window +Dim vPersistent As Variant, oForm As Object If _ErrorHandler() Then On Local Error Goto Error_Function @@ -2402,7 +2405,10 @@ Dim oWindow As _Window iType = acDocument sDocumentType = docWriter End Select - If iType = acForm Or iType = acReport Then ' Identify Form or Report name + If iType = acForm Then ' Identify persistent Form name + vPersistent = Split(oComp.StringValue, "/") + sName = _GetHierarchicalName(vPersistent(UBound(vPersistent) - 1)) + ElseIf iType = acReport Then ' Identify Report name For i = 0 To UBound(oComp.Args()) If oComp.Args(i).Name = "DocumentTitle" Then sName = oComp.Args(i).Value @@ -2448,7 +2454,7 @@ Dim oWindow As _Window Set oFrame = oComp.Frame iType = acDiagram sName = "" - Case "com.sun.star.comp.sfx2.BackingComp" ' Welcome screen + Case "com.sun.star.comp.sfx2.BackingComp" ' Welcome screen Set oFrame = oComp.Frame iType = acWelcome sName = "" diff --git a/wizards/source/access2base/Event.xba b/wizards/source/access2base/Event.xba index 3b5593765f2a..917264ac2a93 100644 --- a/wizards/source/access2base/Event.xba +++ b/wizards/source/access2base/Event.xba @@ -248,6 +248,7 @@ Dim oObject As Object, i As Integer Dim sShortcut As String, sAddShortcut As String, sArray() As String Dim sImplementation As String, oSelection As Object Dim iCurrentDoc As Integer, oDoc As Object +Dim vPersistent As Variant Const cstDatabaseForm = "com.sun.star.comp.forms.ODatabaseForm" If _ErrorHandler() Then On Local Error Goto Error_Function @@ -353,24 +354,18 @@ Const cstDatabaseForm = "com.sun.star.comp.forms.ODatabaseForm" sImplementation = Utils._ImplementationName(oObject) Loop ' Add Forms! prefix -' Select Case oDoc.DbConnect -' Case DBCONNECTBASE - If Utils._hasUNOProperty(oObject, "Args") Then ' Current object is a SwXTextDocument - For i = 0 To UBound(oObject.Args) - If oObject.Args(i).Name = "DocumentTitle" Then - sAddShortcut = Utils._Surround(oObject.Args(i).Value) - Exit For - End If - Next i - End If + Select Case oDoc.DbConnect + Case DBCONNECTBASE + vPersistent = Split(oObject.StringValue, "/") + sAddShortcut = Utils._Surround(_GetHierarchicalName(vPersistent(UBound(vPersistent) - 1))) sShortcut = "Forms!" & sAddShortcut & "!" & sShortcut -' Case DBCONNECTFORM -' sShortcut = "Forms!0!" & sShortcut -' End Select + Case DBCONNECTFORM + sShortcut = "Forms!0!" & sShortcut + End Select sArray = Split(sShortcut, "!") ' If presence of "Forms!myform!myform.Form", eliminate 2nd element - ' Eliminate anyway blanco subcomponents (e.g; Forms!!myForm) + ' Eliminate anyway blanco subcomponents (e.g. Forms!!myForm) If UBound(sArray) >= 2 Then If UCase(sArray(1)) & ".FORM" = UCase(sArray(2)) Then sArray(1) = "" sArray = Utils._TrimArray(sArray) diff --git a/wizards/source/access2base/Form.xba b/wizards/source/access2base/Form.xba index a84a5c141da2..b660564db07f 100644 --- a/wizards/source/access2base/Form.xba +++ b/wizards/source/access2base/Form.xba @@ -21,6 +21,7 @@ Private _Name As String Private _DocEntry As Integer ' Doc- and DbContainer entries in Root structure Private _DbEntry As Integer Private _MainForms As Variant +Private _PersistentName As String Private _IsLoaded As Boolean Private _OpenArgs As Variant Private _OrderBy As String @@ -39,6 +40,7 @@ Private Sub Class_Initialize() _DocEntry = -1 _DbEntry = -1 _MainForms = Array() + _PersistentName = "" _IsLoaded = False _OpenArgs = "" _OrderBy = "" @@ -160,28 +162,23 @@ Function IsLoaded(ByVal Optional pbForce As Boolean) As Boolean End If IsLoaded = False -Dim oDoc As Object, oDatabase As Object, oEnum As Object, oDesk As Object, oComp As Object, bFound As Boolean +Dim oDoc As Object, oDatabase As Object, oEnum As Object, oDesk As Object, oComp As Object, vPersistent As Variant Dim i As Integer Set oDoc = _A2B_.CurrentDocument() Select Case oDoc.DbConnect Case DBCONNECTBASE Set oDesk = CreateUnoService("com.sun.star.frame.Desktop") Set oEnum = oDesk.Components().createEnumeration - bFound = False - Do While oEnum.hasMoreElements And Not bFound ' Search in all open components if one corresponds with current form + Do While oEnum.hasMoreElements ' Search in all open components if one corresponds with current form oComp = oEnum.nextElement - If HasUnoInterfaces(oComp, "com.sun.star.frame.XModule") Then + If _hasUNOProperty(oComp, "Identifier") Then If oComp.Identifier = "com.sun.star.sdb.FormDesign" Then - For i = 0 To UBound(oComp.Args()) - If oComp.Args(i).Name = "DocumentTitle" Then - bFound = ( oComp.Args(i).Value = _Name ) - If bFound Then - _IsLoaded = True - Set Component = oComp - Exit For - End If - End If - Next i + vPersistent = Split(oComp.StringValue, "/") + If vPersistent(UBound(vPersistent) - 1) = _PersistentName Then + _IsLoaded = True + Set Component = oComp + Exit Do + End If End If End If Loop @@ -230,6 +227,7 @@ End Property ' OnApproveParameter (get) Property Let OnApproveParameter(ByVal pvValue As Variant) Call _PropertySet("OnApproveParameter", pvValue) + End Property ' OnApproveParameter (set) REM ----------------------------------------------------------------------------------------------------------------------- @@ -464,7 +462,7 @@ Dim oDatabase As Object, oController As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable - Set oController = oDatabase.Document.getFormDocuments.getByName(_Name) + Set oController = oDatabase.Document.getFormDocuments.getByHierarchicalName(_Name) oController.close() Dispose() mClose = True @@ -478,7 +476,7 @@ Error_NotApplicable: Error_Function: TraceError(TRACEABORT, Err, "Form.Close", Erl) GoTo Exit_Function -End Function +End Function ' Close REM ----------------------------------------------------------------------------------------------------------------------- Public Function Controls(Optional ByVal pvIndex As Variant) As Variant @@ -806,8 +804,9 @@ Dim oDoc As Object, oDatabase As Object If _ErrorHandler() Then On Local Error Goto Trace_Error _Name = psName _Shortcut = "Forms!" & Utils._Surround(psName) + Set oDoc = _A2B_.CurrentDocument() + If oDoc.DbConnect = DBCONNECTBASE Then _PersistentName = oDoc.Document.getFormDocuments().getByHierarchicalName(psName).PersistentName If IsLoaded Then - Set oDoc = _A2B_.CurrentDocument() Select Case oDoc.DbConnect Case DBCONNECTBASE If Not IsNull(Component.CurrentController) Then ' A form opened then closed afterwards keeps a Component attribute @@ -856,7 +855,7 @@ End Sub ' _Initialize V1.1.0 REM ----------------------------------------------------------------------------------------------------------------------- Private Function _PropertiesList() As Variant - If IsLoaded Then + If _IsLoaded Then _PropertiesList = Array("AllowAdditions", "AllowDeletions", "AllowEdits", "Bookmark" _ , "Caption", "CurrentRecord", "Filter", "FilterOn", "Height", "IsLoaded" _ , "Name", "ObjectType", "OnApproveCursorMove", "OnApproveParameter" _ diff --git a/wizards/source/access2base/Methods.xba b/wizards/source/access2base/Methods.xba index 2d5906c7c5bb..8d8cf81d9906 100644 --- a/wizards/source/access2base/Methods.xba +++ b/wizards/source/access2base/Methods.xba @@ -296,4 +296,4 @@ Error_Function: GoTo Exit_Function End Function ' _OptionGroup V1.1.0 -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/access2base/PropertiesGet.xba b/wizards/source/access2base/PropertiesGet.xba index f41302c1c20f..35da47d401c2 100644 --- a/wizards/source/access2base/PropertiesGet.xba +++ b/wizards/source/access2base/PropertiesGet.xba @@ -448,7 +448,7 @@ Dim oDoc As Object Case OBJCOLLECTION Select Case vCurrentObject._CollType Case COLLFORMS - vCurrentObject = Application.Forms(sComponents(iCurrentIndex)) + vCurrentObject = Application.AllForms(sComponents(iCurrentIndex)) Case COLLALLDIALOGS sDialog = UCase(sComponents(iCurrentIndex)) vCurrentObject = Application.AllDialogs(sDialog) diff --git a/wizards/source/access2base/Root_.xba b/wizards/source/access2base/Root_.xba index 3cfe3e5d5a67..df295f8ca53a 100644 --- a/wizards/source/access2base/Root_.xba +++ b/wizards/source/access2base/Root_.xba @@ -105,9 +105,9 @@ Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Varian iCurrentDoc = CurrentDocIndex( , False) ' False prevents error raising if not found If iCurrentDoc < 0 Then GoTo Exit_Sub ' If not found ignore - vDocContainer = CurrentDoc(iCurrentDoc) + vDocContainer = CurrentDocument(iCurrentDoc) With vDocContainer - If Not .Active Then GoTo Exit_Sub ' e.g. if successive calls to CloseConnection() + If Not .Active Then GoTo Exit_Sub ' e.g. if multiple calls to CloseConnection() For i = 0 To UBound(.DbContainers) If Not IsNull(.DbContainers(i).Database) Then .DbContainers(i).Database.Dispose() diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba index 5c1af669fddb..56006e555374 100644 --- a/wizards/source/access2base/Utils.xba +++ b/wizards/source/access2base/Utils.xba @@ -726,6 +726,7 @@ Dim bIsPseudo As Boolean, bPseudoExists As Boolean, vObject As Variant If Not bIsPseudo Then Goto Exit_Function Dim oDoc As Object, oForms As Variant +Const cstSeparator = "\;" bPseudoExists = False With vObject @@ -733,12 +734,7 @@ Dim oDoc As Object, oForms As Variant Case OBJFORM If ._Name <> "" Then ' Check validity of form name Set oDoc = _A2B_.CurrentDocument() - If oDoc.DbConnect = DBCONNECTFORM Then - bPseudoExists = True - Else - Set oForms = oDoc.Document.getFormDocuments() - bPseudoExists = ( oForms.HasByName(._Name) ) - End If + If oDoc.DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = _InList(._Name, Application._GetAllHierarchicalNames()) End If Case OBJDATABASE If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = Not IsNull(.Connection) |