“堆栈空间不足”在 vba 中使用递归函数进行访问

Question

I'm reaching out to you because I'm getting troubles coding a module for an Access program.

Introduction:

I got 4 Tables: Products, Receipes, Ordonnancement & Commands. Ordonnancement and Commands have the same structure, the second one being the result of the processing of the commands through the receipes.

Goal of the VBA Module:

I'm creating a Module to create records to the Ordonnancement table by processing the commands through the receipes. In detail, I use a recursive function to cope with the variable deepth of the receipes that allows me to loop through the Receipes Table and generate the need in all Products for one date.

Remarks:

-I normally work in C# using EF to work with databases. After several tries to use directly the RecordSet possibilities of Access, I decided to generate POCO classes for ReceipeLign and OrdoLign, to stock the data of the tables in collections of those objects, work with those and then commit to the Access tables adding records to each RecordSet.

-I work in french, so I translated a few things so it can be understood by everyone. It might not be perfect, let me know if not clear.

Code:

Option Compare Database
Option Explicit

Dim cnc As New ADODB.Connection
Dim CRecordSet As New ADODB.Recordset
Dim FTRecordSet As New ADODB.Recordset
Dim ORecordSet As New ADODB.Recordset

Public Sub GenerateOrdonnancement()

'Retrieving info from tables Commandes & FT in RecordSets.
Set cnc = CurrentProject.Connection
Set CRecordSet = cnc.Execute("SELECT * FROM Commandes")
Set FTRecordSet = cnc.Execute("SELECT * FROM FichesTechniques")
Set ORecordSet = cnc.Execute("SELECT * FROM Ordonnancement")

'Creation of the list to receive data from the tables
Dim Commandes As New Collection
Dim FicheTechniques As New Collection

'Retrieving commands and receipes
Dim Commande As ligneOrdo
Dim ordo As ligneOrdo
Dim FT As ligneFT

Do Until CRecordSet.EOF

    Set Commande = New ligneOrdo
    Commande.DateCommande = CRecordSet("dateCommande").Value
    Commande.Produit = CRecordSet("Produit").Value
    Commande.Quantite = CRecordSet("quantite").Value
    Commandes.Add Commande
    CRecordSet.MoveNext

Loop
CRecordSet.Close


Do Until FTRecordSet.EOF

    Set FT = New ligneFT
    FT.Nom = FTRecordSet("Nom").Value
    FT.Ingredient = FTRecordSet("Ingredient").Value
    FT.Quantite = FTRecordSet("quantité").Value
    FT.IsComposed = FTRecordSet("Composé").Value
    FicheTechniques.Add FT
    FTRecordSet.MoveNext

Loop
FTRecordSet.Close


'creation of the collection of ordo
'Later: versionning of the Ordonnancements
Dim AProduire As New Collection

Dim mr As ligneOrdo
For Each mr In Commandes
    Dim coll As Collection
    Set coll = CreateOrdoLigne(mr, FicheTechniques)
    Dim item As New ligneOrdo
    For Each item In coll
        AProduire.Add item
    Next item
Next mr

'Adding and saving the coll AProduire in the RecordSetO
cnc.BeginTrans
Dim item2 As ligneOrdo
For Each item2 In AProduire
    ORecordSet.AddNew
    ORecordSet("DateCommande").Value = item2.DateCommande
    ORecordSet("Produit").Value = item2.Produit
    ORecordSet("Quantite").Value = item2.Quantite
    ORecordSet.Update
Next item2

ORecordSet.Close

cnc.CommitTrans

End Sub

Function CreateOrdoLigne(ligne As ligneOrdo, FT As Collection) As Collection

Dim ordo As New Collection

Dim ligneFT As Variant
'Loop through the receipes
For Each ligneFT In FT
    If ligneFT.Nom = ligne.Produit Then
        Dim AProduire As New ligneOrdo
        AProduire.Produit = ligneFT.Ingredient
        AProduire.DateCommande = ligne.DateCommande
        AProduire.Quantite = ligne.Quantite * ligneFT.Quantite
        ordo.Add AProduire
        If ligneFT.IsComposed = True Then
            Dim ordoList2 As New Collection
            Set ordoList2 = CreateOrdoLigne(AProduire, FT)
            Dim recordOrdo As ligneOrdo
            For Each recordOrdo In ordoList2
                ordo.Add recordOrdo
            Next recordOrdo
            Set ordoList2 = Nothing
        End If
        Set AProduire = Nothing
    End If
Next ligneFT


Set CreateOrdoLigne = ordo

End Function

Problem Statement:

Running the Module, I get a Run-Time Error 28 : "Out of stack Space", which seems after some reseach a common thing working with recursive functions in such tight environnements. Problem is, I can't really optimize the process. I am looking for direct ways to bypass this error or ideas to tackle this problem in another way.

Thank you all,

Answer 1

So after some debuging with @Andre 's help, I found out that the recursivity was infinite, hence the error on the size. Even with that, Access was not able to generate so much data and stock it somewhere beforme commiting those changes to the database.

I have found a way around that problem, which consists in:

• avoiding using functions to be stocked in a collection. I therefore transformed the function into a sub.
• commiting the changes to the database along the generation process.
• obj = Nothing when it is not needed anymore in a repeatable process.

What I have learnt and maybe could help others

• Analyse the recursive process to see what could make it infinite, define error handlers accordingly
• Debug.Print is an efficient way to debug in vba ACCESS, to generate data and check the whole process.

Thank you @Andre and the others for your time, hope it will help others.