Link to home
Start Free TrialLog in
Avatar of gfaucher
gfaucher

asked on

adodc too many active users

Hi!!

    At the run time of a program, there is an error i can't fix.  It start with a windows with the adodc name and it says too many active user.

    When I click ok, another window appear. It says runtime error '-2147467259(80004005)'

    I don't know why it append or why and I'd like to learn how to fix this error
Avatar of tkuppinen
tkuppinen

What's your db?  SQL server will only allow for so many active connections.
Avatar of gfaucher

ASKER

I'm using an access db
Avatar of Éric Moreau
This is an ugly error!

I did have this error which have a description of "Unknown error" I think.

I have sometimes corrected it using a client side cursor (instead of the server side default).

What is the code that cause this error?
emoreau

It might be that because the program is accessing a db on another drive on the network.  

Would you tell me how to do it
How do you open your recordset?

Before opening your recordset, you should set the CursorLocation like this:
Set rstTemp = New Recordset
rstTemp.CursorLocation = adUseClient
rstTemp.Open pstrQuery, mdbConnect, pCursorType, pLockType
I'm not really used to this.  Normally I use an adodc then i enter the query by the line of code adodc.recordsource = query then adodc.refresh.

This is how i get my information in the db
Instead of using ADO Data control, if you use ADO code, do you still have the error?
What do you mean by ado code??
Don't use ADO Data Control and use code like my comment of Thursday, April 06 2000 - 04:04PM EDT
It doesn't work, it gives me the same error number right at the beginning.  
2 things:

1) Have you tried on another database (nwind.mdb for example)?

2) Can we see code?
This is the code where the error always occurs.

Private Sub CmdListe2_Click()
'Imprime la liste des employés à appeler pour le surtemps en x copie(s)
Dim CompteurDeb As Integer
Dim CompteurFin As Integer
Dim TabClasse(1 To 50, 1 To 5) As Variant
Dim TabProd(1 To 50, 1 To 5) As Variant
Dim TabMaint(1 To 50, 1 To 5) As Variant
Dim TabApprenti(1 To 50, 1 To 5) As Variant
Dim Temp(1 To 5) As Variant
Dim TNo As Integer
Dim Compt1 As Integer
Dim Compt2 As Integer
Dim Compt3 As Integer
Dim Compt4 As Integer

    AdoEmployes.RecordSource = "Select * from Employes where Matricule Like '" _
                                & AdoClassempl.Recordset.Fields("Matricule") & "%'"
    AdoTempSup.RecordSource = "Select * from RequeteHeureSup where Matricule Like '" _
                                & AdoClassempl.Recordset.Fields("Matricule") & "%'"
    TxtAttente.Text = "Le système compile les données"
    TxtAttente.Visible = True
    TxtAttente.SetFocus
    Call Module1.SavePeriode
    AdoListe2.Recordset.MoveFirst
    While Not AdoListe2.Recordset.EOF
        AdoListe2.Recordset.Delete
        AdoListe2.Recordset.MoveNext
    Wend
    AdoListe2.Refresh
    AdoClasse.Recordset.MoveFirst
    While Not AdoClasse.Recordset.EOF
        'Vide le tableau
        For i = 1 To 50
            For j = 1 To 5
                TabClasse(i, j) = ""
                TabProd(i, j) = ""
                TabMaint(i, j) = ""
                TabApprenti(i, j) = ""
            Next
        Next
        Compt1 = 0
        Compt2 = 0
        Compt3 = 0
        Compt4 = 0
        TClasse = AdoClasse.Recordset.Fields("Classe")
        AdoClassempl.Recordset.MoveFirst
        While Not AdoClassempl.Recordset.EOF
        'Ceux qui sont de la classe TClasse
            If AdoClassempl.Recordset.Fields("Classe") = TClasse Then
                Compt1 = Compt1 + 1
               
                AdoEmployes.Refresh
                AdoTempSup.Refresh
               
                TabClasse(Compt1, 1) = TClasse
                TabClasse(Compt1, 2) = AdoEmployes.Recordset.Fields("Nom")
                TabClasse(Compt1, 3) = AdoEmployes.Recordset.Fields("Prenom")
                TabClasse(Compt1, 4) = AdoEmployes.Recordset.Fields("Tel")
                TabClasse(Compt1, 5) = AdoTempSup.Recordset.Fields("TotHeure")
               
            Else
                'Ceux qui ne soont pas de la classe TClasse mais
                'qui ont la sous classe TClasse sans être apprenti
                'et qui sont de la productivité
                If (AdoClassempl.Recordset.Fields("Classe") <> TClasse) _
                And (AdoClassempl.Recordset.Fields("Classe") <> "AO") _
                And (AdoClassempl.Recordset.Fields("Classe") <> "AM") _
                And (AdoClassempl.Recordset.Fields("ClasseSecond") Like "*" & TClasse & "*") _
                And (Not (AdoClassempl.Recordset.Fields("Maintenance"))) Then
                    Compt2 = Compt2 + 1
                                       
                    AdoEmployes.Refresh
                    AdoTempSup.Refresh
                   
                    TabProd(Compt2, 1) = TClasse
                    TabProd(Compt2, 2) = AdoEmployes.Recordset.Fields("Nom")
                    TabProd(Compt2, 3) = AdoEmployes.Recordset.Fields("Prenom")
                    TabProd(Compt2, 4) = AdoEmployes.Recordset.Fields("Tel")
                    TabProd(Compt2, 5) = AdoTempSup.Recordset.Fields("TotHeure")
                Else
                    'Ceux qui ne sont pas de la classe TClasse,
                    'qui ont la sous-classe TClasse, sans être
                    'apprenti et qui sont de la maintenance
                    If (AdoClassempl.Recordset.Fields("Classe") <> TClasse) _
                    And (AdoClassempl.Recordset.Fields("Classe") <> "AO") _
                    And (AdoClassempl.Recordset.Fields("Classe") <> "AM") _
                    And (AdoClassempl.Recordset.Fields("ClasseSecond") Like "*" & TClasse & "*") _
                    And (AdoClassempl.Recordset.Fields("Maintenance")) Then
                        Compt3 = Compt3 + 1
                        AdoEmployes.Refresh
                        AdoTempSup.Refresh
                       
                        TabMaint(Compt3, 1) = TClasse
                        TabMaint(Compt3, 2) = AdoEmployes.Recordset.Fields("Nom")
                        TabMaint(Compt3, 3) = AdoEmployes.Recordset.Fields("Prenom")
                        TabMaint(Compt3, 4) = AdoEmployes.Recordset.Fields("Tel")
                        TabMaint(Compt3, 5) = AdoTempSup.Recordset.Fields("TotHeure")
                    Else
                        'Les apprentis
                        If ((AdoClassempl.Recordset.Fields("Classe") = "AO") _
                        Or (AdoClassempl.Recordset.Fields("Classe") = "AM")) _
                        And (AdoClassempl.Recordset.Fields("ClasseSecond") Like "*" & TClasse & "*") Then
                            Compt4 = Compt4 + 1
                            AdoEmployes.Refresh
                            AdoTempSup.Refresh
                           
                            TabApprenti(Compt4, 1) = TClasse
                            TabApprenti(Compt4, 2) = AdoEmployes.Recordset.Fields("Nom")
                            TabApprenti(Compt4, 3) = AdoEmployes.Recordset.Fields("Prenom")
                            TabApprenti(Compt4, 4) = AdoEmployes.Recordset.Fields("Tel")
                            TabApprenti(Compt4, 5) = AdoTempSup.Recordset.Fields("TotHeure")
                        End If
                    End If
                End If
            End If
            AdoClassempl.Recordset.MoveNext
        Wend
To minimize changes in your code, open a connection, then a recordset a copy this recordset to your ADODC with this code:

Option Explicit

Private mdbConnect As ADODB.Connection

Private Sub Command1_Click()
Dim rstTemp As ADODB.Recordset

    Set rstTemp = New ADODB.Recordset
    rstTemp.Open "SELECT * from Employees", mdbConnect, adOpenStatic
    Set Adodc1.Recordset = rstTemp
   
    Set rstTemp = New ADODB.Recordset
    rstTemp.Open "SELECT * from Products", mdbConnect, adOpenStatic
    Set Adodc2.Recordset = rstTemp
   
    MsgBox Adodc1.Recordset.RecordCount
    MsgBox Adodc2.Recordset.RecordCount
End Sub

Private Sub Form_Load()
    Set mdbConnect = New ADODB.Connection
    With mdbConnect
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Microsoft Visual Studio\VB98\Nwind.mdb;Persist Security Info=False"
        .Open
    End With
End Sub

Before getting this in your code, delete all your datacontrols and recreate them to be sure you have properties set correctly.

At best, you delete all the Data Controls on your forms.

BTW, instead of this code (that clear the array):
        'Vide le tableau
        For i = 1 To 50
            For j = 1 To 5
                TabClasse(i, j) = "" 
                TabProd(i, j) = "" 
                TabMaint(i, j) = "" 
                TabApprenti(i, j) = "" 
            Next
        Next

You can use:
   Erase TabClasse
   Erase TabProd
   Erase TabMaint
   Erase TabApprenti
I fixed the code I've sent you before. is the solution the same for this code?


Private Sub CmdNextDate_Click()

    Call Module1.EmptyRecord
    CalDateSur.Value = CalDateSur.Value + 1
    TxtHeureRef.SetFocus
    AdoHeureSup.Recordset.CursorLocation = adUseClient
    AdoHeureSup.RecordSource = "Select * from TempSup where MATRICULE like '" _
    & AdoEmploye.Recordset.Fields("Matricule") & "%' and Date like '" _
    & CalDateSur.Value & "%'"
    AdoHeureSup.Refresh
    Call Module1.CheckNoMatch
    TxtHeureRef.SetFocus
End Sub

Private Sub CmdNextEmp_Click()
   
    Call Module1.EmptyRecord
    If Not AdoEmploye.Recordset.EOF Then
        AdoEmploye.Recordset.MoveNext
        If Not AdoEmploye.Recordset.EOF Then
            AdoHeureSup.RecordSource = "Select * from TempSup where MATRICULE like '" _
            & AdoEmploye.Recordset.Fields("Matricule") & "%' order by date"
            AdoHeureSup.Refresh
           
            If AdoHeureSup.Recordset.RecordCount <> 0 Then
                AdoHeureSup.Recordset.MoveLast
                obj.MoveLast
                'CalDateSur.Value = AdoHeureSup.Recordset.Fields(1)
            Else
                AdoHeureSup.Recordset.AddNew
                AdoHeureSup.Recordset.Fields("Matricule") = _
                AdoEmploye.Recordset.Fields("Matricule")
                CalDateSur.Value = Premier
                CboDateSur.Text = CalDateSur.Value
                TxtHeureRef.Text = 0
                TxtHeureAcc.Text = 0
            End If
        End If
    End If
    TxtHeureRef.SetFocus
End Sub

Private Sub CmdPrevDate_Click()

    Call Module1.EmptyRecord
    CalDateSur.Value = CalDateSur.Value - 1
    AdoHeureSup.Recordset.CursorLocation = adUseClient
    AdoHeureSup.RecordSource = "Select * from TempSup where MATRICULE like '" _
    & AdoEmploye.Recordset.Fields("Matricule") & "%' and Date like '" _
    & CalDateSur.Value & "%'"
    AdoHeureSup.Refresh
    Call Module1.CheckNoMatch
    TxtHeureRef.SetFocus
End Sub

Private Sub CmdPrevEmp_Click()
    Call Module1.EmptyRecord
    If Not AdoEmploye.Recordset.BOF Then
        AdoEmploye.Recordset.MovePrevious
        If Not AdoEmploye.Recordset.BOF Then
            AdoHeureSup.Recordset.CursorLocation = adUseClient
            AdoHeureSup.RecordSource = "Select * from TempSup where Matricule like '" _
            & AdoEmploye.Recordset.Fields("Matricule") & "%' Order by Date"
            AdoHeureSup.Refresh
            If AdoHeureSup.Recordset.RecordCount <> 0 Then
                AdoHeureSup.Recordset.MoveLast
                'CalDateSur.Value = AdoHeureSup.Recordset.Fields(1)
            Else
                AdoHeureSup.Recordset.AddNew
                AdoHeureSup.Recordset.Fields("Matricule") = _
                AdoEmploye.Recordset.Fields("Matricule")
                CalDateSur.Value = Premier
                CboDateSur.Text = CalDateSur.Value
            End If
        End If
    End If
    TxtHeureRef.SetFocus
End Sub
Private Sub CmdSave_Click()
    AdoHeureSup.Recordset.Update
End Sub

Private Sub DGEmploye_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    AdoHeureSup.RecordSource = "Select * from TempSup where MATRICULE like '" _
            & AdoEmploye.Recordset.Fields("Matricule") & "%' order by date"
    AdoHeureSup.Refresh
    AdoHeureSup.Recordset.MoveLast
    CalDateSur.Value = AdoHeureSup.Recordset.Fields(1)
End Sub
Private Sub Form_Load()
    AdoHeureSup.RecordSource = "Select * from TempSup where MATRICULE like '" _
            & AdoEmploye.Recordset.Fields("Matricule") & "%' order by date"
    AdoHeureSup.Refresh
    AdoHeureSup.Recordset.MoveLast
    CalDateSur.Value = AdoHeureSup.Recordset.Fields(1)
   
End Sub
The concept of minimizing the connections is always good!
But when I insert or modify data, I ahve no other way to do so than connect to the db?

Are you telling me that when I refresh the adodc, I create a new connection?
These lines bind a recordset to a ADODC:
rstTemp.Open "SELECT * from Employees", mdbConnect, adOpenStatic
Set Adodc1.Recordset = rstTemp

(mdbConnect is my connection)

What I say is to open ONE connection and bind all your adodc on that connection (like the code I gave you yesterday).
i'll try this, thanks a lot.  

BTW, What can i do with expert points that i got??  I'm a new user of this site.
There is not much to do with it!

If you have enough points, you appear in the EE Hall of Fame (today's lowest has 87226 points).

Experts had a surprise last february. Experts who were ranked in the top 100 had the choice of receiving a palm pilot or a scanner absolutely free.

EE said that there will be other gift like that one!
I'Ve seen that you are from Montréal, do you speek french because I'm from Sorel, Québec.  Our exchange would certainely be easier.
Certainement que je parle français. C'est ma langue maternelle!
ca c'est cool!!! un expert de ma langue.

J'ai essayer ton code et ca marche très bien pour aficher les données mais je ne peut pas en insérer.  lorsque je tape adodc.recordset.addnew, je recoit une erreur qui dit: L'opération demandée par l'application n'est pas prise en charge par le fournisseur.

A l'ouverture du recordset, ajoute un paramètre:
rstTemp.Open "SELECT * from Employees", mdbConnect, adOpenStatic, adLockPessimistic
Ca semble fonctionner, est-ce garantie que je n'aurai plus cette erreur maintenant??
ASKER CERTIFIED SOLUTION
Avatar of Éric Moreau
Éric Moreau
Flag of Canada image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Merci beaucoup!!! avant que je trouve ce site, ca faisait déjà une semaine que je me cassait la tête sur ce problème.

Pourrais-tu svp m'envoyer ton adresse e-mail afin que je puisse te contacter en cas de besoin.  Moi c'est g_faucher@hotmail.com,  je te garantie que je ne l'utiliserai pas pour rien.