sIn( 0 ) = "Мid": sIn( 1 ) = "Жid"
    For iSx =  0  To  1         
        rstS(iSx).Index = sIn(iSx)
    next iSx

    For iSx =  0  To  1 
        With rstS(iSx)
            '.Index = sIn(iSx) - уже задан, не будем!'
            ...
                    End With
                    '.Index = sIn(iSx) 'НЕ мог смениться

Option Compare Database
Option Explicit
  Dim dbs As Database, rstDesc As Recordset, rstS( 0  To  1 ) As Recordset, rstD As Recordset ', n As Long
  Private Pc(0 To 0) As Long, Pn(0 To 0) As Long

Sub startM()
    Dim iSx As Long
    Dim sIn(0 To 1) As String
    Set dbs = CurrentDb
    dbs.Execute ("Delete From потомки")
    Set rstDesc = dbs.OpenRecordset("потомки")
    
    sIn(0) = "Мid": sIn(1) = "Жid"
    For iSx = 0 To 1
        Set rstS(iSx) = dbs.OpenRecordset("семьи", dbOpenTable)
        rstS(iSx).Index = sIn(iSx)
    Next iSx

    Set rstD = dbs.OpenRecordset("дети", dbOpenTable)
    rstD.Index = "СемьяРебенок"
    FindDescendantM 1, 1 '29,  1 
    rstDesc.Close
    Set rstDesc = Nothing
    For iSx =  0  To  1 
        rstS(iSx).Close
        Set rstS(iSx) = Nothing
    Next iSx
    rstD.Close
    Set rstD = Nothing
End Sub

Sub FindDescendantM(id As Long, iGeneration As Long)
    On Error Resume Next
    Dim i As Long, nS As Long, nR As Long, iSx As Long
    'Set rst = dbs.OpenRecordset("SELECT ребенок FROM семьи LEFT JOIN дети ON семьи.id=дети.семья WHERE Not ребенок Is Null AND (муж=" & id & " OR жена=" & id & ")")
    Dim sIn(0 To 1) As String
    sIn(0) = "Мid": sIn(1) = "Жid"
    For iSx = 0 To 1
        With rstS(iSx)
            '.Index = sIn(iSx)
            .Seek ">=", id,  0 
            If Not .NoMatch Then
                Do While .Fields(iSx +  1 ) = id
                    nS = .Fields("id")
                    With rstD
                        .Seek ">=", nS,  0 
                        If Not rstD.NoMatch Then
                            Do While .Fields("Семья") = nS
                                nR = .Fields("Ребенок")
                                With rstDesc
                                    .AddNew
                                    .Fields( 0 ) = nR
                                    .Fields( 1 ) = iGeneration
                                    .Update
                                End With
                                i = iGeneration +  1 
                                FindDescendantM nR, i
                                .Seek ">", nS, nR
                                If .NoMatch Then Exit Do
                            Loop
                        End If
                    End With
                    '.Index = sIn(iSx) 'мог смениться
                    .Seek ">", id, nS
                    If .NoMatch Then Exit Do
                Loop
            End If
        End With
    Next iSx
End Sub

Option Compare Database
Option Explicit
Private dbs As Database, rstDesc As Recordset, rstS( 0  To  1 ) As Recordset, rstD As Recordset ', n As Long
Private pC() As Long, pN() As Long

Sub startA()
    Dim iSx As Long
    Dim sIn(0 To 1) As String
    Set dbs = CurrentDb
    dbs.Execute ("Delete From потомки")
    Set rstDesc = dbs.OpenRecordset("потомки")
    
    sIn(0) = "Мid": sIn(1) = "Жid"
    For iSx = 0 To 1
        Set rstS(iSx) = dbs.OpenRecordset("семьи", dbOpenTable)
        rstS(iSx).Index = sIn(iSx)
    Next iSx

    Set rstD = dbs.OpenRecordset("дети", dbOpenTable)
    rstD.Index = "СемьяРебенок"
    FindDescendantAll 1, 1 '29,  1 
    rstDesc.Close
    Set rstDesc = Nothing
    For iSx =  0  To  1 
        rstS(iSx).Close
        Set rstS(iSx) = Nothing
    Next iSx
    rstD.Close
    Set rstD = Nothing
End Sub

Sub FindDescendantAll(id As Long, iGeneration As Long)
Dim nP As Long, nC As Long, iG As Long, bF As Boolean
Dim iC As Long

    On Error Resume Next
    bF = FindDescendantA(id, iGeneration)   'первый вызов
    iG = iGeneration
    Do While bF  'цикл по поколениям
        If (bF) Then  'лишняя проверка, осталась от отладки :)
            'переместим следующих в текущий
            Erase pC
            ReDim pC( 0  To UBound(pN))
            For iC =  0  To UBound(pN)
                pC(iC) = pN(iC)
            Next iC
        End If
        Erase pN    'очистка следующего
        bF = False
        iG = iG + 1
        For nC = 0 To UBound(pC)
            bF = FindDescendantA(pC(nC), iG) Or bF
        Next nC
    Loop
End Sub

Function FindDescendantA(id As Long, iGeneration As Long) As Boolean
    Dim i As Long, nS As Long, nR As Long, iSx As Long
    On Error Resume Next        
    For iSx = 0 To 1
        With rstS(iSx)
            '.Index = sIn(iSx)
            .Seek ">=", id,  0 
            If Not .NoMatch Then
                Do While .Fields(iSx +  1 ) = id
                    nS = .Fields("id")
                    With rstD
                        .Seek ">=", nS,  0 
                        If Not rstD.NoMatch Then
                            Do While .Fields("Семья") = nS
                                nR = .Fields("Ребенок")
                                With rstDesc
                                    .AddNew
                                    .Fields( 0 ) = nR
                                    .Fields( 1 ) = iGeneration
                                    .Update
                                End With
                                i = iGeneration +  1 
                                FindDescendantA = True 'есть хоть один
                                'FindDescendantA nR, i
                                Dim kN As Long
                                kN = UBound(pN) +  1 
                                ReDim Preserve pN( 0  To kN)
                                pN(kN) = nR 'вызовем потом
                                '.Seek ">", nS, nR
                                .MoveNext
                                If .NoMatch Then Exit Do
                            Loop
                        End If
                    End With
                    '.Seek ">", id, nS
                    .MoveNext
                    If .NoMatch Then Exit Do
                Loop
            End If
        End With
    Next iSx
End Function

            Erase pC
            ReDim pC( 0  To UBound(pN))
            For iC =  0  To UBound(pN)
                pC(iC) = pN(iC)
            Next iC