vba code not doing INSERT into database - ms-access

I am very new to access. I was told that the way to do a database insert in access is with the CurrentDb object (as long as the table is in the same database, and it is in my case.) I made this code, have no errors, but it doesn't do the insert.
Private Sub Add_Delete_Click()
Dim query As String
query = "Insert Into tbl_Inventory_History (InventoryID, Modification_Date, Change)"
query = query & "Values (" & Me.InventoryID & ",#" & Now() & "#," & Me.Quantity & ")"
CurrentDb.Execute query
End Sub
This code is run on a button click in the Inventory form page. I want it to insert any changes made to the inventory on the inventory history page. I made sure the the tbl_Inventory_History does exist and is spelled correctly. What is the issue?

Instead of "gluing together" a SQL statement, you might find it more convenient in this case to add the record by using a Recordset, like this
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tbl_Inventory_History", dbOpenTable)
rst.AddNew
rst!InventoryID = Me.InventoryID
rst!Modification_Date = Now()
rst!Change = Me.Quantity
rst.Update
rst.Close
Set rst = Nothing

Related

VBA SQL Sum Operation in Form

In my form i want to use a sum on row SWS from tblKurse used in the query for the form. On a Button Click event i want to sum the values in that row whenever the criterion in my where is met. Problem is i get an invalid argument error whenever i run it. I just cant find my mistake. Maybe someone can help.
Heres the function that i call after the button click event:
Public Function chkSWS() As Integer
Dim db As Database
Dim rst As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT SUM(tblKurse.SWS) As Stunden " _
& "FROM tblKurse " _
& "WHERE tblKurse.Dozent_ID = " & Me.cmbKursDOzent
Debug.Print strSQL
Debug.Print Me.Dozent_ID
Set rst = db.OpenRecordset(strSQL, dbForwardOnly)
chkSWS = rst![Stunden]
Set rst = Nothing
Set db = Nothing
End Function
Error points on the "Set rst" line, so it might been a bad Select statement?
printed SQL Statement:
SELECT SUM(tblKurse.SWS) As Stunden FROM tblKurse WHERE tblKurse.Dozent_ID = 1
Change this line
Set rst = db.OpenRecordset(strSQL, dbForwardOnly)
to this
Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)

MS ACCESS how to change a query criteria to look up a record and then create a report

enter image description herei have a program that create field tickets, when the ticket is finished i can see it in a list box name FinishedJobs, when i double click on a ticket inside the listbox it ask me if i want to reopen it or send it to print. The first one (reopen) is done but the second one i can't get it to work.
The problem is i have the ticket number in a variable named strCriteria and i want to use that value and put it in the criteria inside the query name JobsTicketGeneralReport, so i can open a report using that query.
PLEASE HELP ME TO CHANGE THE CRITERIA IN THE QUERY TO SEARCH MY TICKET NUMBER. I'M WILLING TO CHANGE THE CODES IF YOU SUGGEST THAT.
NOTE: My query is a combine query it has 6 tables and has the ticket number in common, when i call the ticket number it bring the information of all tables.
This what i am doing:
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As Recordset
Dim varItem As Variant
Dim strCriteria As String
Dim qdfOld As String
Dim strSQL As String
' Get the database and stored query
Set db = CurrentDb()
Set qdf = db.QueryDefs("JobsticketGeneralReport")
' Loop through the selected items in the list box and build a text string
For Each varItem In Me!List0.ItemsSelected
strCriteria = strCriteria & ",'" & Me.List0.Column(0) & "'"
Next varItem
' Check that user selected something
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list" _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
'Debug.Print strCriteria
' Remove the leading comma from the string
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
Debug.Print strCriteria
' change criteria in query
qdf.Parameters(0).Value = Trim(strCriteria)
Set rst = qdf.OpenRecordset
DoCmd.OpenQuery "JobsticketgeneralReport"
DoCmd.OpenReport "JobsticketgeneralReport", acpreview
rst.Close
qdf.Close
Set rst = Nothing
Set qdf = Nothing
HERE IS MY SQL:
SELECT JobsOrder.StartDigDate, JobsOrder.Ticket, JobsOrder.DigNumber, JobsOrder.JobType,
JobsOrder.JobAddressNumber, JobsOrder.JobAddressName, JobsOrder.JobAddressTown,
JobsOrder.JobDescription, JobsOrder.AssetID, JobsOrder.Notes, JobsOrder.FINISH,
JobsOrder.updateGIS, JobsOrder.Priority, GENERAL.STARTJOBDATE, GENERAL.ENDJOBDATE,
GENERAL.DAY1, GENERAL.DAY2, GENERAL.EMPLOYEE0, GENERAL.EMPLOYEE1, GENERAL.EMPLOYEE2,
GENERAL.EMPLOYEE3, GENERAL.EMPLOYEE4, GENERAL.EMPLOYEE5, GENERAL.EMPLOYEE6,
GENERAL.EMPLOYEE7, GENERAL.VEHICLE0, GENERAL.VEHICLE1, GENERAL.VEHICLE2,
GENERAL.VEHICLE3, GENERAL.VEHICLE4, GENERAL.VEHICLE5, GENERAL.EMPLOYEE0TIME,
GENERAL.EMPLOYEE1TIME, GENERAL.EMPLOYEE2TIME, GENERAL.EMPLOYEE3TIME,
GENERAL.EMPLOYEE4TIME, GENERAL.EMPLOYEE5TIME, GENERAL.EMPLOYEE6TIME,
GENERAL.EMPLOYEE7TIME, GENERAL.DRAWINGATT, GENERAL.FINISH, GENERAL.ASPHALT,
GENERAL.ROW, GENERAL.CONCRETE, GENERAL.DIRT, GENERAL.TRENCH, MAINS.[JOBTYPE-MAIN],
MAINS.MATERIAL, MAINS.SIZE, MAINS.DEPTH, MAINS.INTERNALCONDITION, MAINS.COMMENTS,
MAINS.REPAIRLOCATION, MAINS.LOCATION1, MAINS.LOCATION2, MAINS.MATERIAL1,
MAINS.MATERIAL2, MAINS.MATERIAL3, MAINS.MATERIAL4, MAINS.MATERIAL5,
MAINS.MATERIAL6, MAINS.MATERIAL7, MAINS.MATERIAL8, MAINS.MATERIAL9,
MAINS.MATERIAL10, MAINS.MATERIAL11, MAINS.MATERIAL12, MAINS.QTY1, MAINS.QTY2,
MAINS.QTY3, MAINS.QTY4, MAINS.QTY5, MAINS.QTY6, MAINS.QTY7, MAINS.QTY8,
MAINS.QTY9, MAINS.QTY10, MAINS.QTY11, MAINS.QTY12, MAINS.ENABLE, SERVICES.JOBPERFORMBY,
SERVICES.SERVICEASSET, SERVICES.OFFON, SERVICES.[MATERIAL-MC], SERVICES.[SIZE-MC],
SERVICES.[DEPTH-MC], SERVICES.[MATERIAL-CB], SERVICES.[SIZE-CB], SERVICES.[DEPTH-CB],
SERVICES.CURBBOXLOCATION, SERVICES.LOCATION1, SERVICES.LOCATION2, SERVICES.LOCATION3,
SERVICES.[SERVICE-COMMENT], SERVICES.[MATERIAL1-MC], SERVICES.[MATERIAL2-MC],
SERVICES.[MATERIAL3-MC], SERVICES.[MATERIAL4-MC], SERVICES.[MATERIAL5-MC],
SERVICES.[MATERIAL6-MC], SERVICES.[MATERIAL7-MC], SERVICES.[MATERIAL8-MC],
SERVICES.[QTY1-MC], SERVICES.[QTY2-MC], SERVICES.[QTY3-MC], SERVICES.[QTY4-MC],
SERVICES.[QTY5-MC], SERVICES.[QTY6-MC], SERVICES.[QTY7-MC], SERVICES.[QTY8-MC],
SERVICES.[MATERIAL1-CB], SERVICES.[MATERIAL2-CB], SERVICES.[MATERIAL3-CB],
SERVICES.[MATERIAL4-CB], SERVICES.[MATERIAL5-CB], SERVICES.[MATERIAL6-CB],
SERVICES.[MATERIAL7-CB], SERVICES.[MATERIAL8-CB], SERVICES.[QTY1-CB],
SERVICES.[QTY2-CB], SERVICES.[QTY3-CB], SERVICES.[QTY4-CB], SERVICES.[QTY5-CB],
SERVICES.[QTY6-CB], SERVICES.[QTY7-CB], SERVICES.[QTY8-CB], SERVICES.REPAIR,
SERVICES.Replace, SERVICES.INSTALL, SERVICES.REMOVE, SERVICES.TEMPDISCONNECT,
SERVICES.ENABLE, HYDRANT.[ENABLE-H], HYDRANT.[HYDRANT-ASSET], HYDRANT.[REPAIR-H],
HYDRANT.[REPLACE-H], HYDRANT.[INSTALL-H], HYDRANT.FLUSH, HYDRANT.FLOWTEST,
HYDRANT.PARTS1, HYDRANT.PARTS2, HYDRANT.PARTS3, HYDRANT.PARTS4, HYDRANT.PARTS5,
HYDRANT.PARTS6, HYDRANT.PARTS7, HYDRANT.PARTS8, HYDRANT.[QTY1-H], HYDRANT.[QTY2-H],
HYDRANT.[QTY3-H], HYDRANT.[QTY4-H], HYDRANT.[QTY5-H], HYDRANT.[QTY6-H],
HYDRANT.[QTY7-H], HYDRANT.[QTY8-H], HYDRANT.JOBPERFORM, HYDRANT.[MANUFACTORY OLD],
HYDRANT.MANUFACTORY, HYDRANT.SIZENEW, HYDRANT.SIZEOLD, HYDRANT.JOBNOTES,
HYDRANT.TIMEOPEND, HYDRANT.TIMECLOSED, HYDRANT.TIMETOCLEAR, HYDRANT.COLOROPEN,
HYDRANT.COLORCLOSE, HYDRANT.REMARKS, HYDRANT.[STATIC-PRESSURE], HYDRANT.[RESIDUAL-PRESSURE],
HYDRANT.[PITOT-TESTFLOWRATE], HYDRANT.CAPACITY, HYDRANT.[ASSET-ID1],
HYDRANT.[ASSET-ID2], VALVES.ENABLE, VALVES.[REPAIR-V], VALVES.[REPLACE-V],
VALVES.[INSTALL-V], VALVES.[REMOVE-V], VALVES.[MAINTENANCE-V], VALVES.VALVECOMMENT,
VALVES.[MATERIAL1-V], VALVES.[MATERIAL2-V], VALVES.[MATERIAL3-V], VALVES.[MATERIAL4-V],
VALVES.[MATERIAL5-V], VALVES.[MATERIAL6-V], VALVES.[QTY1-V], VALVES.[QTY2-V],
VALVES.[QTY3-V], VALVES.[QTY4-V], VALVES.[QTY5-V], VALVES.[QTY6-V],
VALVES.[LOCATION1-V], VALVES.[LOCATION2-V], VALVES.[LOCATION3-V], VALVES.[LOCATION4-V],
VALVES.VALVE1, VALVES.VALVE2, VALVES.VALVE3, VALVES.VALVE4, VALVES.VALVE5,
VALVES.VALVE6, VALVES.VALVE7, VALVES.VALVE8, VALVES.VALVEPOSITION1,
VALVES.VALVEPOSITION2, VALVES.VALVEPOSITION3, VALVES.VALVEPOSITION4,
VALVES.VALVEPOSITION5, VALVES.VALVEPOSITION6, VALVES.VALVEPOSITION7,
VALVES.VALVEPOSITION8, VALVES.[VALVE-TURNS1], VALVES.[VALVE-TURNS2],
VALVES.[VALVE-TURNS3], VALVES.[VALVE-TURNS4], VALVES.[VALVE-TURNS5],
VALVES.[VALVE- TURNS6], VALVES.[VALVE-TURNS7], VALVES.[VALVE-TURNS8],
VALVES.[VALVE-DEPTH1], VALVES.[VALVE-DEPTH2], VALVES.[VALVE-DEPTH3],
VALVES.[VALVE-DEPTH4], VALVES.[VALVE-DEPTH5], VALVES.[VALVE-DEPTH6],
VALVES.[VALVE-DEPTH7], VALVES.[VALVE-DEPTH8], VALVES.REASON1, VALVES.REASON2,
VALVES.REASON3, VALVES.REASON4, VALVES.REASON5, VALVES.REASON6, VALVES.REASON7,
VALVES.REASON8, INSPECT.ENABLE, INSPECT.[CURBBOX-I], INSPECT.[VALVEBOX-I],
INSPECT.[SERVICE-I], INSPECT.CURBBOXREMARKS, INSPECT.VALVEBOXREMARKS, INSPECT.SERVICEREMARKS
FROM (((((JobsOrder
INNER JOIN [GENERAL] ON JobsOrder.Ticket = GENERAL.TICKET)
INNER JOIN MAINS ON GENERAL.TICKET = MAINS.TICKET)
INNER JOIN SERVICES ON MAINS.TICKET = SERVICES.TICKET)
INNER JOIN HYDRANT ON SERVICES.TICKET = HYDRANT.TICKET)
INNER JOIN VALVES ON HYDRANT.TICKET = VALVES.TICKET)
INNER JOIN INSPECT ON VALVES.TICKET = INSPECT.TICKET
WHERE (((JobsOrder.Ticket)=[ticket])
AND ((JobsOrder.FINISH)=True))
ORDER BY JobsOrder.StartDigDate, JobsOrder.Ticket;
If you want to use a parameter in the query, you should explicitly define it. Also, it is a good idea to give the parameter a different name than the involved tables and fields.
To do this, use the "Parameters" window in query design, or add a PARAMETERS clause to the beginning of the SQL:
PARAMETERS parTicket Text ( 255 );
SELECT .....
and in the WHERE clause
WHERE (((JobsOrder.Ticket)=[parTicket])
This is mainly useful if you want to read data from the query in VBA, i.e. you need this for
Set rst = qdf.OpenRecordset
But if the query is RecordSource for a report, this won't work, because the report opens its own instance of the query. In this case, you need Parfait's solution: directly use the listbox in the query.
WHERE ((JobsOrder.Ticket) = Forms!yourForm!List0)
For Each varItem In Me!List0.ItemsSelected
strCriteria = strCriteria & ",'" & Me.List0.Column(0) & "'"
Next varItem
This cannot work - you must use varItem in the loop.
Me.List0.Column(0) will always pick the same element.
Debug.Print strCriteria
This should have told you what went wrong.

Error 3218: Could not update; currently locked

I've been looking through the other questions related to mine, but most are about multi-user and this one came close but not quite.
System
MS Access 2013
with Linked Tables to Office 365 Sharepoint
tblQuote - frmQuote
tblQuoteItems - sbfrmQuoteItems
No Record Locks
I'm attempting to setup a select all/deselect all button that when clicked runs db.Execute Update on the tblQuoteItems where equal to Quote ID and Quote Version.
I have a button on the main form that calls the below process.
Public Sub SelectLineItems(strTable As String, strID As String, _
intID As Integer, bln As Boolean, Optional intVersion As Integer)
Dim db As Database
Dim strSQL As String
Dim strVersion As String
Set db = CurrentDb
strSQL = "UPDATE " & strTable & " SET [Selected] = "
If intVersion > 0 Then
strVersion = " AND [QuoteVersion] = " & intVersion
Else
strVersion = ""
End If
If bln Then
strSQL = strSQL + "False WHERE " & strID & " = " & intID & strVersion & ";"
Else
strSQL = strSQL + "True WHERE " & strID & " = " & intID & strVersion & ";"
End If
db.Execute strSQL, dbFailOnError
db.Close
Set db = Nothing
Exit Sub
It's pretty simple, nothing to crazy. The problem occurs when I try to run this after a record has been modified by the form and it still has focus. Because of the dbFailOnError I get the error message, If I remove dbFailOnError it will update every record except the one that has been modified through the form.
If I modify the record then select a different record manually by clicking with the mouse, the record is no longer locked and the Update works with no errors.
I have tried to replicate the process of clicking on a new record and have put the below code
If Me.Dirty Then Me.Dirty = False
In every Event I could think of like:
The subform_Current, subform_Dirty, subform.Control.Dirty/Lost_focus/subform_Before and After Update, The exit event of the subform control on the main form...etc
Placing the code in different areas doesn't make any difference, the first time the code is called it updates the record and I can confirm this in the table, the new value is present.
I've attempted to requery the subform
I've tried
DoCmd.GoToRecord , , acFirst
Then setting focus to the first control of the record.
I've even tried changing the update from the db.Execute to using a recordset object
Dim db As Dao.Database
Dim rs As Dao.Recordset
Dim strSQL As String
Dim strVersion As String
If intVersion > 0 Then
strVersion = " AND [QuoteVersion] = " & intVersion
Else
strVersion = ""
End If
strSQL = "SELECT * FROM " & strTable & " WHERE " & strID & "= " & intID & strVersion
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
With rs
Do Until .EOF
.Edit
!Selected = bln
.Update
.MoveNext
Loop
End With
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
But again it will cycle through every unlocked record and update, until it gets to the one modified by the form which then throws the same error.
I've tried opening the recordset then closing it then reopening it. But it doesn't seem to matter it's the form that's holding onto the locked record.
The only solution that has worked for me was to Set the subform recordsource to nothing, then run the update, then reset the recordsource to what it was.
The Selected column is within the QuoteItems table itself, and not in it's own table with reference to the QuoteItems ID
My question is how do I get the form to release the record through code that mimics the action of manually clicking on a new record without resetting the subform's recordsource.
Your approach with using Dirty=False is the right thing to do. But you have to apply it to the subform, as this is where the recordlock occurs. If your Code is in the Main form, you need to add this before your code to update the records.
Me.sbfrmQuoteItems.Form.Dirty = False
In that line sbfrmQuoteItems is supposed to be the name of the SubForm-Control in your main form!

How to insert several fields into a table using ADO when two of the fields contain commas

I have an ado created recordset in access 2010 it returns 9 different fields from a stored procedure on sql server 2008 r2.
I am trying to use this recordset (which does populate) to insert all of the records into a table that matches the output. My issue is that two of the fields are name fields that have commas in them. For example Smith, Joseph-- I need to insert that comma into the appropriate field. Right now it throws an error because of the comma in the field.
Here is the code that I am using:
Option Compare Database
'Executes the filtering routine
Private Sub cmdApplyFilter_Click()
'If txtStartDate.Value And txtEndDate.Value Is Not Null Then
' QuickFilter
'Else
' DefaultRun
'End If
QuickFilter
'********** Filter as you type **********
'Private Sub txtFilter_Change()
' QuickFilter
'End Sub
End Sub
'Perform the actual filtering on the subform
Private Sub QuickFilter()
Dim Sql As String
Dim filter As String
If txtStartDate = vbNullString Then
'Reset the filter if the textbox is empty
'This will be the default sql statement to fill the subreport
SubForm.Form.FilterOn = False
Else
'Some common substitutions that users may have already inserted as wildchars
filter = Replace(txtStartDate, "%", "*")
filter = Replace("*" & filter & "*", "**", "*")
'Construct the filter for the sql statement
'/*********** GROUP BY GOES HERE ***********/
'Assign the filter to the subform
'SubForm.Form.filter = Sql
'SubFomr.Form.FilterOn = True
End If
End Sub
Private Sub Form_Load()
'Sets up the connection with the sql server database retrieves the stored procedure, executes it and puts the result set into a table
Dim Conn As ADODB.Connection
Dim Cmd As ADODB.Command
Dim Rs As ADODB.Recordset
Dim rs1 As ADODB.Recordset
Dim Connect As String
Dim filter As String
Connect = "Provider =SQLNCLI10; Data Source=10.50.50.140; Initial Catalog=CCVG; User Id = oe; Password = Orth03c0; "
'Establish the connection with sql server
Set Conn = New ADODB.Connection
Conn.ConnectionString = Connect
Conn.Open
'Open the recorset
Set Cmd = New ADODB.Command
Cmd.ActiveConnection = Conn
Cmd.CommandText = "dbo.cusGenNoNotesReport"
Cmd.CommandType = adCmdStoredProc
Set Rs = Cmd.Execute()
Dim x As Integer
If Not Rs.BOF And Not Rs.EOF Then
If Not Rs.BOF Then Rs.MoveFirst
Do Until Rs.EOF
For x = 0 To Rs.Fields.Count - 1
MsgBox Rs.Fields(x)
'DoCmd.RunSQL "INSERT INTO tblNoNotes (Provider, Facility, TicketNumber, Charges, FinancialClass, CPT, CPTDescription, PatientFullName, DateOfEntry) SELECT " & Rs.Fields(x).Value & ""
Next x
Rs.MoveNext
Loop
End If
'Process results from recordset, then close it.
'DoCmd.RunSQL "INSERT INTO tblNoNotes (Provider, Facility, TicketNumber, Charges, FinancialClass, CPT, CPTDescription, PatientFullName, DateOfEntry) VALUES (""" & Rs![Provider] & """,""" & Rs![Facility] & """ & Rs![TicketNumber] & """, """ & Rs![Charges] & """, """ & Rs![FinancialClass] & """, """ & Rs![CPT] & """, """ & Rs![CPTDescription] & """, """ & Rs![PatientFullName] & """, """ & Rs![DateOfEntry] & """ )"
Rs.Open
Rs.Close
Conn.Close
Set Rs = Nothing
Set Cmd = Nothing
Set Conn = Nothing
End Sub
You have an ADO Recordset, Rs, which contains data you want to add to your Access table. Instead of trying to fix the INSERT statement to add each row, it should be easier to open a DAO Recordset for the destination table and store the values from each ADO row by adding a new row the the DAO Recordset. Although this is still a RBAR (row by agonizing row) approach, it should be significantly faster than building and executing an INSERT statement for each row.
First of all, make sure to add Option Explicit to your module's Declarations section.
Option Compare Database
Option Explicit
Then use this code to append the ADO Recordset data to your table.
Dim db As DAO.Database
Dim rsDao As DAO.Recordset
Set db = CurrentDb
Set rsDao = db.OpenRecordset("tblNoNotes", _
dbOpenTable, dbAppendOnly + dbFailOnError)
Do While Not Rs.EOF
rsDao.AddNew
rsDao!Provider.Value = Rs!Provider.Value
rsDao!Facility.Value = Rs!Facility.Value
rsDao!TicketNumber.Value = Rs!TicketNumber.Value
rsDao!Charges.Value = Rs!Charges.Value
rsDao!FinancialClass.Value = Rs!FinancialClass.Value
rsDao!CPT.Value = Rs!CPT.Value
rsDao!CPTDescription.Value = Rs!CPTDescription.Value
rsDao!PatientFullName.Value = Rs!PatientFullName.Value
rsDao!DateOfEntry.Value = Rs!DateOfEntry.Value
rsDao.Update
Rs.MoveNext
Loop
rsDao.Close
Set rsDao = Nothing
Set db = Nothing
Note this approach means you needn't worry about whether PatientFullName contains a comma, or apostrophe ... or struggle with properly quoting field values to produce a valid INSERT statement. You simply store the value from one recordset field to the appropriate field in another recordset.
I think the real problem you're complaining about here is that your data in the ADO Recordset has quotes (sometimes called apostrophes) in it. Anytime quotes could possibly exist in your data you will need to check for and escape them before using the data in an SQL Statement. You will need to know this not only for inserts but also for performing filtering and creating WHERE statements as well. For example:
Replace(Rs![PatientFullName], "'", "''")
A simpler way to do this is to make your own little function. The "PQ" stands for pad quotes. You can name it whatever you want.
PQ(rs![PatientFullName])
Public Function PQ(s as String) as String
PQ = Replace(s, "'", "''")
End Function
But I also agree with HansUp that it's much easier to use recordsets for inserts. I basically never use SQL Insert statements anymore, except for places where I have no option such as SQL Server T-SQL.
Be aware that if you do want to use insert statements, you should consider using the following:
CurrentDb.Execute "INSERT INTO Statement Goes Here", dbFailOnError
This is considered to be a more robust solution than DoCmd.RunSQL, mostly because it runs in the context of the underlying Database Engine instead of the Access interface. Using CurrentDb.Execute prevents you from having to use DoCmd.SetWarning statements to turn off warnings.

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
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.