MS Access环境下递归BOM展开实现问题求助

方法一：临时表迭代法 #

这是Access环境下最稳定的实现方式，彻底规避递归深度限制和返回异常问题：

1. 创建临时表存储层级数据 #

' 创建临时表用于存放展开后的完整BOM
Sub CreateTempBOM()
    On Error Resume Next
    CurrentDb.Execute "DROP TABLE TempBOM"
    On Error GoTo 0
    CurrentDb.Execute "CREATE TABLE TempBOM (" & _
        "TopPartID TEXT(50), " & _
        "PartID TEXT(50), " & _
        "Level INT, " & _
        "Qty INT)"
End Sub

2. 迭代展开所有层级 #

Sub ExpandBOM(topPart As String)
    Dim rs As Recordset
    Dim currentLevel As Integer
    
    ' 初始化：插入顶层零件的直接子组件
    CreateTempBOM
    CurrentDb.Execute "INSERT INTO TempBOM (TopPartID, PartID, Level, Qty) " & _
        "SELECT '" & topPart & "', PartID, 0, 1 FROM YourBOMTable WHERE ParentPartID = '" & topPart & "'"
    
    currentLevel = 0
    
    ' 循环处理每一层，直到无新子组件可展开
    Do
        Set rs = CurrentDb.OpenRecordset("SELECT PartID FROM TempBOM WHERE Level = " & currentLevel)
        If rs.RecordCount = 0 Then Exit Do
        
        ' 遍历当前层所有零件，插入其子组件
        Do While Not rs.EOF
            CurrentDb.Execute "INSERT INTO TempBOM (TopPartID, PartID, Level, Qty) " & _
                "SELECT '" & topPart & "', PartID, " & currentLevel + 1 & ", Qty FROM YourBOMTable WHERE ParentPartID = '" & rs!PartID & "'"
            rs.MoveNext
        Loop
        
        rs.Close
        currentLevel = currentLevel + 1
    Loop
    
    ' 输出结果（可根据需求导出到窗体/报表）
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM TempBOM ORDER BY Level, PartID")
    rs.Close
End Sub

方法二：栈模拟递归（解决原递归返回问题） #

如果偏好类似递归的逻辑，用栈手动管理遍历顺序，避免递归函数的返回异常：

Sub StackBasedBOM(topPart As String)
    Dim stack As Collection
    Dim currentItem As Variant
    Dim rs As Recordset
    Dim bomResults As Collection
    
    Set stack = New Collection
    Set bomResults = New Collection
    
    ' 栈元素格式：(零件ID, 当前层级)
    stack.Add Array(topPart, 0)
    
    Do While stack.Count > 0
        ' 弹出栈顶元素（后进先出，模拟深度优先遍历）
        currentItem = stack(stack.Count)
        stack.Remove stack.Count
        
        ' 获取当前零件的子组件
        Set rs = CurrentDb.OpenRecordset("SELECT PartID, Qty FROM YourBOMTable WHERE ParentPartID = '" & currentItem(0) & "'")
        
        ' 将子组件入栈并记录结果
        Do While Not rs.EOF
            bomResults.Add Array(topPart, rs!PartID, currentItem(1) + 1, rs!Qty)
            stack.Add Array(rs!PartID, currentItem(1) + 1)
            rs.MoveNext
        Loop
        rs.Close
    Loop
    
    ' 将结果写入临时表
    CreateTempBOM
    Dim item As Variant
    For Each item In bomResults
        CurrentDb.Execute "INSERT INTO TempBOM (TopPartID, PartID, Level, Qty) " & _
            "VALUES ('" & item(0) & "', '" & item(1) & "', " & item(2) & ", " & item(3) & ")"
    Next
End Sub

原递归代码返回问题排查点 #

如果你的原代码是VBA递归函数，无法返回上层大概率是以下原因：

• 未循环处理当前零件的所有子组件，仅处理了第一个子组件就进入递归
• 递归函数中未捕获错误，导致中途退出无法返回上层
• Access默认递归深度有限，层级过深触发栈溢出

内容的提问来源于stack exchange，提问作者user2059972