• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 442
  • Last Modified:

Cannot open any more tables

So, I've had some help with getting this function to populate a treeview with an ownership structure of a company.  It works good for most companies, however when I get to a company that owns say, 100 companies and all of them have their own ownership structures too, I get an error 'Cannot open any more tables' and when debugged it goes to the rst.open statement in the function.  I have read that 1022 is the maximum number of recordsets that can be opened, and it's possible and probable that that is being reached and exceeded thus causing the problem.

The question I have is if anyone knows a different way for me to populate a treeview with a companies ownership structure when a company is selected.  I will paste the code I am currently using and any help would be appreciated.

***This is where I populate the parent node with the number of companies owned
Sub ShowOwnsCount()
Dim rnode As node
Dim strSelect As String
Dim company As String

    cn.Execute "Delete * from [#tblNodeTemp] where left([OwnID],4) = '" & Left(EntID, 4) & "'"
    TreeView2.Nodes.Clear

    If Right(EntID, 4) = "0000" Then
        WhereEntID = "Left([Owners].[OwnID],4) = '" & Left(EntID, 4) & "'"
    Else
        WhereEntID = "[Owners].[OwnID] = '" & EntID & "' or [Owners].[OwnID] = '" & Left(EntID, 4) & "0000'"
    End If

    Set rst = New ADODB.Recordset

    sqlString = "Insert Into [#tblNodeTemp] ([EntID], [LegalName], [OwnID]) Select DISTINCT [Owners].[EntID] As       [EntID], [Entities].[LegalName] As [LegalName], left([Owners].[OwnID],4) As [OwnID] FROM [Owners] INNER JOIN [Entities] ON [Owners].[EntID] = [Entities].[EntID] where " & WhereEntID & _
                "ORDER BY [Entities].[LegalName], [Owners].[EntID]"

    cn.Execute sqlString

    strSelect = "SELECT DISTINCT 'Owns' AS Expr3, Count([#tblNodeTemp].[LegalName]) AS CountofOwns From [#tblNodeTemp] GROUP BY 'Owns', Left([OwnID],4) having left([ownid],4) = '" & Left(EntID, 4) & "'"

    rst.Open strSelect, cn

    Do While Not rst.EOF
        Set rnode = TreeView2.Nodes.Add(, , , rst!Expr3 & " (" & rst!countofowns & ")")
        TreeView1.Height = 1532
        TreeView2.Height = 5052
        TreeView2.Top = 3560
        company = EntID
        MousePointer = vbHourglass
        *****This is the function that I call that is recursive and is where the error occurs *****
        AddCompanies company, rnode
        MousePointer = vbDefault
       ' If rst!countofowns > 0 Then 'children so add the dummy
       '     Set rnode = TreeView2.Nodes.Add(rnode, tvwChild, , "Dummy")
       ' End If
        rst.MoveNext
    Loop
    rst.Close

    TreeView2.Top = 3560
End Sub

***Function causing error *****
Private Sub AddCompanies(parentCompany As String, parentNode As node)
Dim rst As ADODB.Recordset
Dim node As node
Dim company As String
Dim strSQL As String

Set rst = New ADODB.Recordset
strSQL = "Select Distinct Owners.EntID, Entities.LegalName FROM ([Entities] INNER JOIN Owners ON [Entities].[entid] = Owners.EntID) where left([ownid],4) = '" & Left([parentCompany], 4) & "'"
****where the debug takes when error comes up*****
rst.Open strSQL, cn

While Not rst.EOF
    company = rst!EntID & " - " & rst!LegalName
    Set node = TreeView2.Nodes.Add(parentNode, tvwChild, , company)
    AddCompanies Left(company, 8), node
    rst.MoveNext
Wend
rst.Close
Set rst = Nothing


End Sub

Thank yoU!
0
jamiei
Asked:
jamiei
  • 4
  • 2
  • 2
2 Solutions
 
PreeceCommented:
In AddCompany, print to the immediate (debug) window the contents of strSQL just before each call to open the recordset:

debug.print  strSQL
rst.Open strSQL, cn

Then have a look at the sql string each time the call is made.  You can copy and paste the sql string in question into an Access query or the query analyzer of sql server.  

Hmmmmm, after looking closer at the question, it looks like the recursive calls in AddCompany may not be necessary.  

Try removing the line:

AddCompanies Left(company, 8), node


Hope this helps!
Preece
0
 
PreeceCommented:
Also, I think that after this line:
Set node = TreeView2.Nodes.Add(parentNode, tvwChild, , company)

you need to destroy the temp node:
Set node = Nothing
0
 
zvonkodjCommented:
If your structure so deep is, you have to try not to open so many RS:
* You can try with only one RS
* My Comments begin with '//
* The Lines I added are followed with '####
* cn and rst have to be defined in Sub ShowOwnsCount, other somewhere else, but not in AddCompanies

The very same chnges have to be done in both SUBs



Sub ShowOwnsCount()
Dim rnode As node
Dim strSelect As String
Dim company As String
      Dim RS_ApsPos as Long      '####

    cn.Execute "Delete * from [#tblNodeTemp] where left([OwnID],4) = '" & Left(EntID, 4) & "'"
    TreeView2.Nodes.Clear

    If Right(EntID, 4) = "0000" Then
        WhereEntID = "Left([Owners].[OwnID],4) = '" & Left(EntID, 4) & "'"
    Else
        WhereEntID = "[Owners].[OwnID] = '" & EntID & "' or [Owners].[OwnID] = '" & Left(EntID, 4) & "0000'"
    End If

    Set rst = New ADODB.Recordset

    sqlString = "Insert Into [#tblNodeTemp] ([EntID], [LegalName], [OwnID]) Select DISTINCT [Owners].[EntID] As       [EntID], [Entities].[LegalName] As [LegalName], left([Owners].[OwnID],4) As [OwnID] FROM [Owners] INNER JOIN [Entities] ON [Owners].[EntID] = [Entities].[EntID] where " & WhereEntID & _
                "ORDER BY [Entities].[LegalName], [Owners].[EntID]"

    cn.Execute sqlString

    strSelect = "SELECT DISTINCT 'Owns' AS Expr3, Count([#tblNodeTemp].[LegalName]) AS CountofOwns From [#tblNodeTemp] GROUP BY 'Owns', Left([OwnID],4) having left([ownid],4) = '" & Left(EntID, 4) & "'"

    rst.Open strSelect, cn

    Do While Not rst.EOF
        Set rnode = TreeView2.Nodes.Add(, , , rst!Expr3 & " (" & rst!countofowns & ")")
        TreeView1.Height = 1532
        TreeView2.Height = 5052
        TreeView2.Top = 3560
        company = EntID
        MousePointer = vbHourglass
        *****This is the function that I call that is recursive and is where the error occurs *****
              RS_AbsPos = rst.AbsolutePosition      '####
        AddCompanies company, rnode
                  Set rst = Nothing                              '####
                  rst.Open strSelect, cn                        '####
                  rst.AbsolutePosition = RS_AbsPos      '####
        MousePointer = vbDefault
       ' If rst!countofowns > 0 Then 'children so add the dummy
       '     Set rnode = TreeView2.Nodes.Add(rnode, tvwChild, , "Dummy")
       ' End If
        rst.MoveNext
    Loop
    rst.Close

    TreeView2.Top = 3560
End Sub

***Function causing error *****
Private Sub AddCompanies(parentCompany As String, parentNode As node)
'//Dim rst As ADODB.Recordset
      Dim RS_ApsPos as Long                  '####
Dim node As node
Dim company As String
Dim strSQL As String

'//Set rst = New ADODB.Recordset
      Set rst = Nothing                        '####
strSQL = "Select Distinct Owners.EntID, Entities.LegalName FROM ([Entities] INNER JOIN Owners ON [Entities].[entid] = Owners.EntID) where left([ownid],4) = '" & Left([parentCompany], 4) & "'"
****where the debug takes when error comes up*****
rst.Open strSQL, cn

While Not rst.EOF
    company = rst!EntID & " - " & rst!LegalName
    Set node = TreeView2.Nodes.Add(parentNode, tvwChild, , company)
          RS_AbsPos = rst.AbsolutePosition                  '####
    AddCompanies Left(company, 8), node
          Set rst = Nothing                                          '####
          rst.Open strSQL, cn                                          '####
          rst.AbsolutePosition = RS_AbsPos                  '####
    rst.MoveNext
Wend
rst.Close
Set rst = Nothing

End Sub
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
jamieiAuthor Commented:
This causes an error every time, the rst.absolutepositiion is -1 in value and it won't accept this.  I don't understand how this will solve the problem anyway, can you explain as well as let me know what is wrong?
0
 
zvonkodjCommented:
You are using a recursive function and you can not predict how many times will this function be called. If your recursive function should be 1500 times called, you want to open 1500 different recordSets. It is wrong in your solution.

This the only way to solve your problem is to populate your TreeView with only one RecordSet. Insted of having 1500 or more RecordSets, you have to open, close and reopen this one RecordSet 1500 or more times. But, in this case, after reopening of RS, you have to set the old (previous) position of cursor of this RS

Please try this:

1. After every rst.open you have to add two Commands: rst.movelast and rst.movefirst
2. You should define RS_AbsPos as Variant, not as long
3. Instead of RS_AbsPos = rst.AbsolutePosition  you sholuld write RS_AbsPos = rst.Bookmark
4. Instead if  rst.AbsolutePosition = RS_AbsPos  you should write  rst.Bookmark = RS_AbsPos

Very important: delete definition of RS in your recursive function and define your RS somewhere else.

0
 
PreeceCommented:
I don't know much about items 2, 3, and 4, but I completely agree with zvonkodj on the rest that post.
0
 
jamieiAuthor Commented:
This give me an error of 'not a valid bookmark' and takes me to the rst.bookmark = rs_abspos.  Unfortunately I don't think this solution is going to work for me.
0
 
PreeceCommented:
Not sure if this will help, but here is some code that I wrote to load a treeview from a recordset.  No recursive calls, no bookmarks, one recordset:

Public Sub gsnLoadTreeView(tvX As TreeView, ImageList1 As ImageList)
    Screen.MousePointer = vbHourglass
    Dim oRS As ADODB.Recordset
    Dim sProc As String
    'Dim lRecCount As Long
    Dim sCatName As String
    Dim sItemName As String
    Dim sURL As String
    Dim sKey As String
    Dim lX As Long
    Dim nodX As Node
   
    If tvX.Nodes.Count > 1 Then tvX.Nodes.Clear
    tvX.LineStyle = tvwRootLines ' Linestyle 1
    tvX.Indentation = 2
    tvX.ImageList = ImageList1
   
   
    'sProc = "Select c.CatName, i.ItemName, i.ItemDescription, i.ItemLink from tblCategories c left join tblItems i on i.fkCatID = c.pkCatID group by c.CatName, i.ItemName"
    sProc = "Select c.CatName, i.ItemName, i.ItemDescr, i.ItemLink"
    sProc = sProc & " from tblCategories c"
    sProc = sProc & " left join tblItems i on i.fkCatID = c.pkCatID"
    sProc = sProc & " group by c.CatName, i.ItemName, i.ItemDescr, i.ItemLink"
    sProc = sProc & " order by c.CatName, i.ItemName, i.ItemDescr, i.ItemLink"

    Set oRS = oAdoAccess.gfGetRS(sProc)
   
    'lRecCount = oRS.RecordCount
    lX = 1
    With tvX
        '.Style = tvwTreelinesText ' Style 4.
        '.BorderStyle = vbFixedSingle
        sCatName = ""
        If Not oRS.BOF And Not oRS.EOF Then
            oRS.MoveFirst
            Do While Not oRS.EOF
                If sCatName <> oRS!Catname Then
                    sCatName = oRS!Catname
                    Set nodX = .Nodes.Add(, , "-cat-" & sCatName, sCatName, 1)
                    nodX.Tag = sCatName
                    Set nodX = Nothing
                End If
                sItemName = oFU.gfIsNullSomeChar(oRS!ItemName, "")
                sURL = oFU.gfIsNullSomeChar(oRS!ItemLink, "")
                If sItemName <> "" And sURL <> "" Then
                    Set nodX = .Nodes.Add("-cat-" & sCatName, tvwChild, sURL, sItemName & " - " & sURL, 2)
                    nodX.Tag = sItemName
                    Set nodX = Nothing
                End If
                lX = lX + 1
                oRS.MoveNext
            Loop
        End If
        '.Nodes.Item(2).EnsureVisible
    End With
   
    oRS.Close
    Set oRS = Nothing
   
End Sub
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 4
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now