CODEWITHSUNDEEP
ms-accessvba
Bishop
Bishop

Reputation: 131

MS Access out of stack space when creating query

I am trying to create an Access database that will link together multiple structurally identical databases together. These other databases are exports from a 3D model that have identical tables, but different data in each. What I need to do is report from all the database like they are one big database. How I thought I would approach this is to create queries that would union the individual identical tables from each database into one query, which I could then use in all my other reports. the code I wrote to join the tables together is below. The trouble I'm running into is that , this code gives me an out of stack space error on the "Set QueryDef..." line. Can someone tell me what I'm doing wrong?

Public Sub CreateUnionQueries()
'On Error GoTo Err_CreateUnionQueries
Dim QueryRs As DAO.Recordset
Dim TableRs As DAO.Recordset
Dim QueryDef As DAO.QueryDef
Dim SQLText As String
Dim qry As QueryDef

'Get list of all Foreign Table Names
Set QueryRs = CurrentDb.OpenRecordset("select distinct ForeignName from msysobjects where ForeignName is not null")

'Loop over list to create union queries
If QueryRs.RecordCount <> 0 Then
    Do While Not QueryRs.EOF
        Set TableRs = CurrentDb.OpenRecordset("select Name from msysobjects where ForeignName = """ & QueryRs![ForeignName] & """")
        Do While Not TableRs.EOF
            SQLText = SQLText & "select * from " & TableRs![Name]
            TableRs.MoveNext
            If Not TableRs.EOF Then
                SQLText = SQLText & " UNION ALL "
            End If
        Loop
        'Create union query
        For Each qry In CurrentDb.QueryDefs
            If qry.Name = "Q-" & QueryRs![ForeignName] Then
               DoCmd.DeleteObject acQuery, "Q-" & QueryRs![ForeignName]
            End If
        Next qry
        Set QueryDef = CurrentDb.CreateQueryDef("Q-" & QueryRs![ForeignName], SQLText)
        QueryDef.Close
        Set QueryDef = Nothing
        QueryRs.MoveNext
        TableRs.Close
        Set TableRs = Nothing
    Loop
Else
    MsgBox "No files are linked currently"
End If

QueryRs.Close

Err_CreateUnionQueries:
    MsgBox "We have an error"
    Set QueryRs = Nothing
    Set TableRs = Nothing
    Exit Sub
End Sub

Upvotes: 3

Views: 902

Answers (1)

Bishop
Bishop

Reputation: 131

Oh man, I'm an idiot. Found the problem. When I was looping, I wasn't setting SQLText back to empty, so it was appending my query for table group onto the last. Removed that and now it works as expected. Thank you guys for your help.

Upvotes: 0

Related Questions