Error- Cannot open any more databases

[MJ_Wilkinson]

Hi,

I'm new to the forum and have introduced myself as such in the new members thread. I've inherited a database from someone and have been running the code on it fine for the past few months, occasionally tweaking wherever necessary.

However, now randomly, all of a sudden one section of code is throwing out the error 3048- "cannot open any more databases". It's so strange that it would be fine for months and now all of a sudden this error appears, I've changed no part of this sub.

All this sub is doing is updating tables M01, M02, M05, M08 & M12 from the data sat in Excel base tables, and assigning criteria such as 1 for Pass and 3 for Fail etc, based on performance against that measure in Tbl_Measures (e.g for M01- >0.9=1, <0.9=3).

My basic understanding is that this error is something to do with Access opening the tables and not closing them, but looking in the code I thought that they were being closed.

Anyway, I appreciate this is perhaps a long piece of code, and sorry if it's too long to be putting on these threads, however, any help you guys can offer to diagnose and fix this issue would be greatly appreciated. Looks like I could pick up some really useful info on here, keep up the good work all;

Private Sub RunM01M02M05M08_REVISED()

'MEASURE LOOP

Dim db2 As Database
Dim LRS2 As DAO.Recordset
Dim loca2 As String
Dim valu2 As String

Set db2 = DBEngine(0)(0)
loca2 = "SELECT Measure From Tbl_Measure"

Set LRS2 = db2.OpenRecordset(loca2)
Do While Not LRS2.EOF
valu2 = LRS2("Measure")
LRS2.MoveNext

Dim TABLE As String
TABLE = DLookup("[Table]", "Tbl_Measure", "[Measure]='" & valu2 & "'")

Dim TARNUM As String
TARNUM = DLookup("[MeasureTarNum]", "Tbl_Measures", "[Measure]='" & valu2 & "'")

Dim MP As String
MP = DLookup("[MeasurePeriod]", "Tbl_Measures", "[Measure]='" & valu2 & "'")

Dim CP As String
CP = DLookup("[MeasureClosingPeriod]", "Tbl_Measures", "[Measure]='" & valu2 & "'")

If valu2 = "M02" Then
B1.BackColor = RGB(&H22, &HB1, &H4C)
Else
If valu2 = "M05" Then
B2.BackColor = RGB(&H22, &HB1, &H4C)
Else
If valu2 = "M08" Then
B5.BackColor = RGB(&H22, &HB1, &H4C)
Else
If valu2 = "M12" Then
B5.BackColor = RGB(&H22, &HB1, &H4C)

End If
End If
End If
End If

'BRAND LOOP

Dim DB As Database
Dim LRS As DAO.Recordset
Dim loca As String
Dim valu As String

Set DB = DBEngine(0)(0)
loca = "SELECT CIBrand From Tbl_Brand"

Set LRS = DB.OpenRecordset(loca)
Do While Not LRS.EOF
valu = LRS("CIBrand")
LRS.MoveNext

Dim LLINK As String
LLINK = DLookup("[LinkTable]", "Tbl_Links", "[CIBrand]='" & valu & "' And [Measure]='" & valu2 & "'")

'RETAILER LOOP

Dim db1 As Database
Dim LRS1 As DAO.Recordset
Dim loca1 As String
Dim valu1 As String

Set db1 = DBEngine(0)(0)
loca1 = "SELECT BCICode From Tbl_Ident Where [CIBrand]='" & valu & "'"

Set LRS1 = db1.OpenRecordset(loca1)
Do While Not LRS1.EOF
valu1 = LRS1("BCICode")
LRS1.MoveNext


Dim LCI As Variant
LCI = DLookup("[CICode]", "Tbl_Ident", "[BCICode]='" & valu1 & "'")

'*******************************EARN BACK******************************************
Dim LTAREB As Variant
LTAREB = DLookup("[Tar]", "Tbl_Earnback", "[BCICODE]='" & valu1 & "' And [Measure]='" & valu2 & "'")

If (IsNull(LTAREB)) Then
LTAREB = 0
End If

Dim LACTEB As Variant
LACTEB = DLookup("[Act]", "Tbl_Earnback", "[BCICODE]='" & valu1 & "' And [Measure]='" & valu2 & "'")

If (IsNull(LACTEB)) Then
LACTEB = 0
End If
'***********************************************************************************

Dim LTAR As Variant
LTAR = DLookup("[OBJ]", "" & LLINK & "", "[CICODE]='" & LCI & "'") + LTAREB

Dim LACT As Variant
LACT = DLookup("[ACT]", "" & LLINK & "", "[CICODE]='" & LCI & "'") + LACTEB

Dim LPERC As Variant '3 DECIMAL PLACES
LPERC = Round(DLookup("[VAL]", "" & LLINK & "", "[CICODE]='" & LCI & "'"), 3)


If LPERC >= TARNUM Then

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Tar] = " & LTAR & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Act] = " & LACT & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Perc] = " & LPERC & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [PorF] = '1' Where [BCICode]='" & valu1 & "'"
DoCmd.SetWarnings True

Else

If LPERC < TARNUM And valu2 <> "M05" Then

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Tar] = " & LTAR & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Act] = " & LACT & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Perc] = " & LPERC & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [PorF] = '3' Where [BCICode]='" & valu1 & "'"
DoCmd.SetWarnings True


Else

If LPERC < TARNUM And (valu2 = "M05" And [CP] = 0) Then

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Tar] = " & LTAR & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Act] = " & LACT & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Perc] = " & LPERC & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [PorF] = '2' Where [BCICode]='" & valu1 & "'"
DoCmd.SetWarnings True

Else

If LPERC < TARNUM And (valu2 = "M05" And [CP] = -1) Then

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Tar] = " & LTAR & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Act] = " & LACT & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [Perc] = " & LPERC & " Where [BCICode]='" & valu1 & "'"
DoCmd.RunSQL "UPDATE " & TABLE & " SET [PorF] = '3' Where [BCICode]='" & valu1 & "'"
DoCmd.SetWarnings True

Else

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & TABLE & " SET [PorF] = '0' Where [BCICode]='" & valu1 & "'"
DoCmd.SetWarnings True

End If
End If
End If
End If


Loop
LRS1.Close
Set LRS1 = Nothing
Set db1 = Nothing

Loop
LRS.Close
Set LRS = Nothing
Set DB = Nothing

Loop
LRS2.Close
Set LR2 = Nothing
Set db2 = Nothing

End Sub

 

[moke123]

heres a handy utility that i wish i could take credit for but cant. The author is credited in the code.

just import the one form and run it. it keeps tabs on how many table connections you have open. It is my understatnding that there is a limited amount of connections (255?) and each recordset, listbox, combobox, form recordsource, etc., consumes one or more connections.

 

[MJ_Wilkinson]

Hi Moke,

Thanks for coming back to me, and apologies for the delay in reply, I've been away for the Bank Holiday weekend here. Thanks for posting that tool, he's a smart guy whoever created it.

It says there are 253 available connections at the start. After running my code and this form then shows as "2 initially available". So I think you're right about this. However, I don't understand why this would suddenly be happening. I haven't changed anything and now this won't work at all. I'm tried reducing the number of tabs that i'm importing data from but this doesn't seem to be having any effect.

If anybody would have any ideas as to why this would suddenly happen then I think this could help me diagnose how to fix it?

 

[Minty]

How many records are there in each loop? bear in mind that the number of open recordsets may multiply out if the loops grow.

EDIT : Actually I notice you are using

Set db2 = DBEngine(0)(0)

Try changing all of these to CurrentDB - I seem to remember reading that the use of dbengine(0)(0) had been deprecated due to a change in internal architecture?

 

[static]

Currentdb is just a reference to dbengine(0)(0).

There are 3 databases in use here

Dim DB As Database
Dim db1 As Database
Dim db2 As Database

only one is needed.

dlookup should be avoided if you're getting multiple fields from the same table. use a recordset.

remove DoCmd.SetWarnings true/false
and change DoCmd.RunSQL to db.execute

 

[The_Doc_Man]

Static, just a note of clarification, because your advice is right.

MJ Wilkinson, switching from DoCmd.RunSQL to DB.Execute is good advice, but involves two warnings.

1. DB.Execute works as long as you declare the database object as DAO.Database - which you do, so don't stop providing the qualifier. It is important. And if you tried this with an ADO object, it might not work so nice.

2. When using the DB.Execute method, you have to completely build the finished SQL string before you execute it. This differs from DoCmd.RunSQL, which allows you to include references to things in the Access environment, like a form's text box value that will be evaluated only when RunSQL executes.

The difference for #2 is that .RunSQL acts as a pre-processor before it sends the SQL to the DB Engine. The .Execute just sends the string straight to the DB Engine, so it has to be complete already when you send it.

 

[Lateral]

Thanks for the utility that displays the number of table connections! I have been chasing this issue for a while and I can now see what is actually happening....all I need to figure out is how to fix it!

Cheers
Greg

 

[CJ_London]

do your tables use lookups? I seem to recall each lookup will go towards the count

 

[bsacheri]

heres a handy utility that i wish i could take credit for but cant. The author is credited in the code.

just import the one form and run it. it keeps tabs on how many table connections you have open. It is my understatnding that there is a limited amount of connections (255?) and each recordset, listbox, combobox, form recordsource, etc., consumes one or more connections.

I was the original author of that utility. I'm glad to hear that it has been helpful to others. I recently discovered that it has been enhanced and made available on Colin's website. I'd post a link to it but I don't have enough reputation here.

 

[Lateral]

Hi guys,


I discovered that I had many forms that had tabs that contained other sub forms that were all being opened when the main form was being opened.


These sub forms all had queries some of which were complex and this is what was eating up my handles.


I changed the logic so that the subforms were opened on when the specific tab was clicked.


This made a significant difference is handle usage and also speed!


Cheers
Greg