How to run parameterized query from VBA. Parameters sourced from recordset - vba

I have a form where a user selects a vendor's name from a combobox, whose catalog file is to be imported. The combobox selection then drives a query to create a one-record recordset (rsProfile) containing several profile variables queried from a table of all vendor profiles. These variables are then used in a series of different queries to reformat, translate and normalize the vendor's uniquely structured files to a standardized format that can be imported into our system.
I am frustrated that I can't figure out how to build my stored queries that will use one or more parameters that are automatically populated from the profile recordset.
Here is my rsProfile harvesting code. It works. Note that intVdrProfileID is a global variable set and used in other places.
Private Sub btn_Process_Click()
Dim ws As Workspace
Dim db, dbBkp As DAO.Database
Dim qdf As DAO.QueryDef
Dim rsProfile, rsSubscrip As Recordset
Dim strSQL As String
Dim strBkpDBName As String
Dim strBkpDBFullName As String
strBkpDBName = Left(strVdrImportFileName, InStr(strVdrImportFileName, ".") - 1) & "BkpDB.mdb"
strBkpDBFullName = strBkpFilePath & "\" & strBkpDBName
Set db = CurrentDb
Set ws = DBEngine.Workspaces(0)
MsgBox ("Vendor Profile ID = " & intVdrProfileID & vbCrLf & vbCrLf & "Backup file path: " & strBkpFilePath)
' Harvest Vendor Profile fields used in this sub
strSQL = "SELECT VendorID, Div, VPNPrefix, ImportTemplate, " & _
"VenSrcID, VenClaID, ProTyp, ProSeq, ProOrdPkg, ProOrdPkgTyp, JdeSRP4Code, " & _
"PriceMeth, " & _
"ProCost1Frml, ProCost2Frml, " & _
"ProAmt1Frml, ProAmt2Frml, ProAmt3Frml, ProAmt4Frml, ProAmt5Frml " & _
"FROM tZ100_VendorProfiles " & _
"WHERE VendorID = " & intVdrProfileID & ";"
Set qdf = db.QueryDefs("qZ140_GetProfileProcessParms")
qdf.SQL = strSQL
Set rsProfile = qdf.OpenRecordset(dbOpenSnapshot)
DoCmd.OpenQuery "qZ140_GetProfileProcessParms"
' MsgBox (qdf.SQL)
I have used QueryDefs to rewrite stored queries at runtime, and although it works, it is quite cumbersome and does not work for everything.
I was hoping for something like the sample below as a stored query using DLookups. I can get this to work in VBA, but I can't get anything to work with stored queries. I am open to other suggestions.
Stored Query "qP0060c_DirectImportTape":
SELECT
DLookUp("[VPNPrefix]","rsProfile","[VendorID]=" & intVdrProfileID) & [PartNo] AS VenPrtId,
Description AS Des,
DLookup("[Jobber]","rsProfile",[VendorID=" & intVdrProfileID) AS Amt1,
INTO tP006_DirectImportTape
FROM tJ000_VendorFileIn;
ADDENDUM:
Let me adjust the problem to make it a bit more complex. I have a collection of about 40 queries each of which use a different collection of parameters (or none). I also have a table containing the particular set of queries that each vendor 'subscribes' to. The goal is to have a database where a non-coding user can add new vendor profiles and create/modify the particular set of queries which would be run against that vendor file. I have almost 100 vendors so far, so coding every vendor seperately is not practical. Each vendor file will be subjected to an average of 14 different update queries.
Simplified Example:
Vendor1 file needs to be processed with queries 1, 2 and 5. Vendor2 file might need only update queries 2 and 4. The parameters for these queries might be as follows:
query1 (parm1)
query2 (parm1, parm4, parm8, parm11)
query4 (parm5, parm6, parm7, parm8, parm9, parm10, parm11)
query5 () -no parms required
This is the core query processing that loops through only the queries relevant to the current vendor file. rsSubscrip is the recordset (queried from a master table) containing this filtered list of queries.
' Run all subscribed queries
MsgBox "Ready to process query subscription list."
With rsSubscrip
Do While Not .EOF
db.Execute !QueryName, dbFailOnError
.MoveNext
Loop
.Close
End With

You can set the parameters of a predefined query using the syntax;
Set qdf = CurrentDB.QueryDefs(QueryName)
qdf.Parameters(ParameterName) = MyValue
To add parameters to the query, add the following before the SELECT statement in the sql
PARAMETERS [ParameterOne] DataType, [ParameterTwo] DataType;
SELECT * FROM tblTest;

Related

How to fix runtime error '3048' "Cannot open any more databases."

I have a form with a button that calls and filters a couple of union queries with about 40 SELECT queries total in between them. It then displays the data in a report. Each SELECT query in the Union query collects records from multiple unique tables in the database. I recently had to add a couple more SELECT queries into the union query to grab records from new tables which is when I got the runtime error. It was opening the report fine before I added these SELECT queries so im under the assumption is there are too many SELECT queries in the UNION query. To resolve this issue, do I simply not use a UNION query and find an alternative way to combine records? or is it something in the VBA code that needs adjustment?
Here is my code
Private Sub Command189_Click()
DoCmd.SetWarnings False
DoCmd.Close acReport, "Operator Daily Review"
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strSQL As String
Set db = CurrentDb()
Set qdf = db.QueryDefs("Productivity_WeeklyFinal")
Set qdf2 = db.QueryDefs("qFiller_Names")
strSQL = "SELECT Info_ME_Employees.ID, gs_1_week_finalUnion.SampleID,
gs_1_week_finalUnion.Operator, Format$([TestDate],'m/dd/yyyy') AS Test_Date,
gs_1_week_finalUnion.Test FROM Info_ME_Employees INNER JOIN gs_1_week_finalUnion ON
Info_ME_Employees.Full_Name = gs_1_week_finalUnion.Operator" & _
" WHERE Info_ME_Employees.ID IN (4,5,6,7)AND gs_1_week_finalUnion.TestDate Between (Date()-7-
Weekday(Date(),2)) And (Date()-Weekday(Date(),2)-1) " & _
" ORDER BY gs_1_week_finalUnion.Operator"
strSQL2 = "SELECT Info_ME_Employees.ID, Info_ME_Employees.Full_Name FROM Info_ME_Employees" & _
" WHERE Info_ME_Employees.ID IN (4,5,6,7)"
qdf.SQL = strSQL
qdf2.SQL = strSQL2
DoCmd.OpenReport "Operator Daily Review", acViewReport
Set db = Nothing
Set qdf = Nothing
End Sub
I think that there is a limit of tables that can be included in a UNION query - possibly 32. Therefore your options are:
Create several UNION queries, and then UNION them all together as the final step;
Insert the data into a temp table using each individual part of the union query.
Additionally, there may be some way that your database could be re-designed, as it is quite unusual to have to have some many unions needed.
Regards,
Actually, the statement for this "error" is incorrect!
“Cannot open any more databases.” What microsoft should have said here is that no more links to a database can be opened. That is why adding more UNIONs caused this error. Because each separate reference to a link to an object (table or query) causes another link (microsoft uses the term "database") to be opened.

How can I combine these two SQL queries (Access/VBA)

I am using two SQL queries in VBA that i believe they could be done in one, but I cant get it to work. I Want to turn the VBA portion into a Query outside of VBA, the VBA keeps breaking my file due to the amount of data it processes. (By break i mean it gives a message that says "this file is not a valid database" rendering the file corrupted). I search for that error but all i found was not related to breaking because of VBA code.
Anyways, here are the two queries ran with VBA.
SELECT ET.VerintEID AS EID, Sum(ET.ExceptMin)/60 AS Exeptions
FROM Tbl_VExceptTime AS ET
INNER JOIN Tbl_VCodes ON ET.Exception = Tbl_VCodes.Exception
WHERE (ET.ExceptDate Between #" & sDate & "# And #" & eDate & "#)
GROUP BY ET.VerintEID, Tbl_VCodes.IsApd
HAVING Tbl_VCodes.IsApd = ""OFF"";
I loop these results to update a table.
Do While Not .EOF
SQL = "UPDATE Tbl_AttendanceByAgent SET EXC = " & recSet.Fields(1).Value & _
" WHERE VerintID = '" & recSet.Fields(0).Value & "'"
CurrentDb.Execute SQL
.MoveNext
Loop
I know that i can save the results from the first query into a table and without looping I can update the main table with another SQL query, but I believe it can be done on a single SQL. I have tried using an UPDATE with a SELECT of the first query but it just errors out on me with an invalid syntax.
Yes this could be achieved in one single query as shown below
UPDATE Tbl_AttendanceByAgent
SET Tbl_AttendanceByAgent.EXC = t2.Exeptions
from Tbl_AttendanceByAgent t1
inner join (
SELECT ET.VerintEID AS EID, Sum(ET.ExceptMin)/60 AS Exeptions
FROM Tbl_VExceptTime AS ET
INNER JOIN Tbl_VCodes as TV ON ET.Exception = TV.Exception
WHERE (ET.ExceptDate Between #" & sDate & "# And #" & eDate & "#)
GROUP BY ET.VerintEID, TV.IsApd
HAVING Tbl_VCodes.IsApd = 'OFF'
) AS t2 on t2.EID = t1.VerintID
Note: I suppose you will replace sDate, eDate with values within your code
This question is an answer to the described errors and the given code, although it technically does not answer the request for a single SQL statement. I started adding a comment, but that's just too tedious when this answer box allows everything to be expressed efficiently at once.
First of all, referring to CurrentDb is actually NOT a basic reference to a single object instance. Rather it is more like a function call that generates a new, unique "clone" of the underlying database object. Calling it over and over again is known to produce memory leaks, and at the least is very inefficient. See MS docs for details.
Although the given code is short, it's not sweet. Not only is it repeatedly creating new database objects, it is repeatedly executing an SQL statement to update what I assume is a single row each time. That also entails regenerating the SQL string each time.
Even if executing the SQL statement repeatedly was an efficient option, there are better ways to do that, like creating a temporary (in-memory) QueryDef object with parameters. Each loop iteration then just resets the parameters and executes the same prepared SQL statement.
But in this case, it may actually be more efficient to load the table being updated into a DAO.Recordset, then use the in-memory Recordset to search for a match, then use the recordset to update the row.
I suspect that addressing a couple of those issues would make your VBA code viable.
Dim db as Database
Set db = CurrentDb 'Get just a single instance and reuse
Dim qry as QueryDef
SQL = "PARAMETERS pEXC Text ( 255 ), pID Long; " & _
" UPDATE Tbl_AttendanceByAgent SET EXC = pEXC " & _
" WHERE VerintID = pID"
set qry = db.CreateQueryDef("", SQL)
'With recSet '???
Do While Not .EOF
qry.Parameters("pEXC") = recSet.Fields(1).Value
qry.Parameters("pID") = recSet.Fields(0).Value
qry.Execute
.MoveNext
Loop
'End With recSet '???
'OR an alternative
Dim recUpdate As DAO.Recordset2
Set recUpdate = db.OpenRecordset("Tbl_AttendanceByAgent", DB_OPEN_TABLE)
Do While Not .EOF
recUpdate.FindFirst "VerintID = " & recSet.Fields(0).Value
If Not recUpdate.NoMatch Then
recUpdate.Edit
recUpdate.Fields("EXC") = recSet.Fields(1).Value
recUpdate.Update
End If
.MoveNext
Loop
I realized in commenting on Gro's answer, that the original query's aggregate clauses will produce unique values on EID, but it then becomes obvious that there is no need to group on (and sum) values which do not have Tbl_VCodes.IsApd = 'OFF'. The query would be more efficient like
SELECT ET.VerintEID AS EID, Sum(ET.ExceptMin)/60 AS Exeptions
FROM Tbl_VExceptTime AS ET
INNER JOIN Tbl_VCodes ON ET.Exception = Tbl_VCodes.Exception
WHERE (ET.ExceptDate Between #" & sDate & "# And #" & eDate & "#)
AND Tbl_VCodes.IsApd = 'OFF'
GROUP BY ET.VerintEID;
BTW, you could consider implementing the same temporary QueryDef pattern as I showed above, then you'd change the first WHERE expression to something like
PARAMETERS PsDate DateTime, PeDate DateTime;
...
WHERE (ET.ExceptDate Between [PsDate] And [PeDate])
...

Access Error 3141

I am trying to set recordset for a report using the following query:
Dim RS As Recordset
Set RS = CurrentDb.OpenRecordset("Select DISTINCT SalesOrders.SalesOrderNumber, Vendors.Name, SalesOrders.OrderDate, SalesOrders.Grade, SalesOrders.QuantityUOM, SalesOrders.PortOfDischarge, SalesOrders.Quantity, IIf([SalesOrders.DTHCIncludedYN],'DTHC INCLUDED','DTHC NOT INCLUDED') AS DTHCIncludedYN," & _
" SalesOrders.DeliveryTerms, SalesOrders.SalesOrderID, SalesOrders.GenesisDocumenationAssistant, Products.ProductLoadPorts, Customers.CustomerType, SalesOrders.UnitPriceUOM, SalesOrders.UnitPrice, Customers.CustomerName, Products.ProductName, SalesOrders.PaymentTerms, SalesOrders.PlaceOfDelivery, SalesOrders.SalesCommission, SalesOrders.LatestShipDate, [SalesOrders.Quantity]*[UnitPrice] AS Amount," & _
" IIf([AdvisingBank]='GEB','GREAT EASTERN BANK',IIf([AdvisingBank]='BOC','BANK OF CHINA',IIf([AdvisingBank]='CB','CATHAY BANK',IIf([AdvisingBank]='HSBC','HSBC Bank USA',IIf([AdvisingBank]='COM','COMMERCE BANK'))))) AS [Bank Name]," & _
" IIf([CCICType]= '1','ONE ORIGINAL INSPECTION CERTIFICATE ISSUED BY CCIC NORTH AMERICA INC','ONE ORIGINAL PRESHIPMENT INSPECTION CERTIFICATE ISSUED BY ANY CCIC EUROPEAN OFFICE') AS [CCIC-Clause]," & _
" IIf([OnCarriageIncluded],'ON CARRIAGE INCLUDED','ON CARRIAGE NOT INCLUDED') AS OCIText, IIf(IsNull([PlaceOfDelivery]),[PortOfDischarge],[PlaceOfDelivery]) AS PODText, Vendors.AB1AddressLine1, Vendors.SupplierLocation AS [Swift Code], " & _
" IIf(IsNull(AdvisingBank),' ','TEL ' & [Vendors.AB1Phone] & ', ' & 'FAX ' & [Vendors.AB1Fax]) AS [Contact Details], IIf(IsNull(AdvisingBank),'',Vendors.AB1AddressLine1 & ', ' & [Vendors.AB1City] & ', ' & [Vendors.AB1State] & ' ' & [Vendors.AB1Zip] & ' ' & [Vendors.AB1Country]) AS AddressLine," & _
" FROM (Products INNER JOIN (Customers INNER JOIN SalesOrders ON Customers.CustomerID = SalesOrders.CustomerID) ON Products.Grade = SalesOrders.Grade) LEFT JOIN Vendors ON SalesOrders.AdvisingBank = Vendors.VendorID " & _
" WHERE (SalesOrders.SalesOrderNumber= Forms!frmPrintContracts!txtGreenSales AND ((Customers.CustomerType)='GREEN' Or (Customers.CustomerType)='GREEN-JC' Or (Customers.CustomerType)='GREEN-DL' Or (Customers.CustomerType)='SIHU' Or (Customers.CustomerType)='PAPYRUS'))ORDER BY SalesOrders.SalesOrderNumber DESC ")
I am getting error saying that I have used reserved keyword or there is a punctuation mistake. Can anyone help me figure out what the error is.
Any help is appreciated. Thank you
Consider saving your SQL statement as an Access stored query and not VBA string for the following reasons:
All syntax errors are checked before you save. You cannot save via the MS Access query design GUI a non-compilable query.
Stored Access queries are more efficient than VBA string queries as the database engine saves the best execution plan for stored queries and cannot when called on the fly in VBA.
You can set a saved query to most Access objects (comboboxes or listboxes row sources, form or report recordsources) with less code.
Me.cboText.RowSource = "myStoredQuery"
Me.cboText.RowSourceType = "Table/Query"
Me.cboText.Requery
Me.Form.RecordSource = "myStoredQuery"
Me.Form.Requery
Your application code is more readable and maintainable as you avoid the VBA string concatenation. Plus, you abstract away the special-purpose nature of SQL from your application layer code.
Dim RS As Recordset
Set RS = CurrentDb.OpenRecordset("myStoredQuery")
The industry standard of parameterization is easier to achieve with stored queries which can serve as a prepared statement. If you ever need to pass VBA variable values for dynamic querying, you can parameterize stored queries with PARAMETERS clause and querydefs all while still using stored queries. See example below:
Stored Query
PARAMETERS [myParam] Date;
SELECT DISTINCT SalesOrders.SalesOrderNumber
FROM SalesOrders
WHERE SalesOrders.OrderDate = [myParam]
VBA
Dim qdef As QueryDef
Dim RS As Recordset
Set qdef = Currentdb.QueryDefs("myStoredQuery")
qdef!myParam = Date()
Set RS = qdef.OpenRecordset()

Adding a new record with VBA

I have a form in which one of the ComboBoxes lists all the documents of a given project. The user should select one and after pressing a button, and if present in Table Dessinsit opens a second form showing that record. If it is not present in that table, I want to add it in.
One of my collegues told me all I had to do was to execute an SQL query with VBA. What I have so far is this:
Dim rsDessin As DAO.Recordset
Dim strContrat As String
Dim strProjet As String
Dim strDessin As String
Dim sqlquery As String
'I think these next 3 lines are unimportant. I set a first query to get information I need from another table
strDessin = Me.Combo_Dessin
strProjet = Me.Combo_Projet
sqlquery = "SELECT [Projet HNA] FROM [Projets] WHERE [Projet AHNS] = '" & strProjet & "'"
Set rsDessin = CurrentDb.OpenRecordset(sqlquery)
If Not rsDessin.RecordCount > 0 Then 'If not present I want to add it
strContrat = rsDessin![Projet HNA]
sqlquery = "INSERT INTO Feuilles ([AHNS], [Contrat], [No Projet]) VALUES (strDessin, strContrat, strDessin)"
'Not sure what to do with this query or how to make sure it worked.
End If
'Checking my variables
Debug.Print strProjet
Debug.Print strContrat
Debug.Print strDessin
'By here I'd like to have inserted my new record.
rsDessin.Close
Set rsDessin = Nothing
I also read online that i could achieve a similar result with something like this:
Set R = CurrentDb.OpenRecordset("SELECT * FROM [Dessins]")
R.AddNew
R![Contrat] = strContrat
R![Projet] = strProjet
R![AHNS] = strDessin
R.Update
R.Close
Set R = Nothing
DoCmd.Close
Is one way better than the other? In the case where my INSERT INTO query is better, what should I do to execute it?
You're asking which is preferable when inserting a record: to use an SQL statement issued to the Database object, or to use the methods of the Recordset object.
For a single record, it doesn't matter. However, you could issue the INSERT statement like this:
CurrentDb.Execute "INSERT INTO Feuilles ([AHNS], [Contrat], [No Projet]) VALUES (" & strDessin & ", " & strContrat & ", " & strDessin & ")", dbFailOnError
(You should use the dbFailOnError option to catch certain errors, as HansUp points out in this answer.)
For inserting multiple records from another table or query, it is generally faster and more efficient to issue an SQL statement like this:
Dim sql = _
"INSERT INTO DestinationTable (Field1, Field2, Field3) " & _
"SELECT Field1, Field2, Field3 " & _
"FROM SourceTable"
CurrentDb.Execute sql
than the equivalent using the Recordset object:
Dim rsSource As DAO.Recordset, rsDestination As DAO.Recordset
Set rsSource = CurrentDb.OpenRecordset("SourceTable")
Set rsDestination = CurrentDb.OpenRecordset("DestinationTable")
Do Until rs.EOF
rsDestination.AddNew
rsDestination!Field1 = rsSource!Field1
rsDestination!Field2 = rsSource!Field2
rsDestination!Field3 = rsSource!Field3
rsDestination.Update
rs.MoveNext
Loop
That said, using an SQL statement has its limitations:
You are limited to SQL syntax and functions.
This is partially mitigated in Access, because SQL statements can use many VBA built-in functions or functions that you define.
SQL statements are designed to work on blocks of rows. Per-row logic is harder to express using only the Iif, Choose, or Switch functions; and logic that depends on the current state (e.g. insert every other record) is harder or impossible using pure SQL. This can be easily done using the Recordset methods approach.
This too can be enabled using a combination of VBA and SQL, if you have functions that persist state in module-level variables. One caveat: you'll need to reset the state each time before issuing the SQL statement. See here for an example.
One part* of your question asked about INSERT vs. Recordset.AddNew to add one row. I suggest this recordset approach:
Dim db As DAO.Database
Dim R As DAO.Recordset
Set db = CurrentDb
Set R = db.OpenRecordset("Dessins", dbOpenTable, dbAppendOnly)
With R
.AddNew
!Contrat = rsDessin![Projet HNA].Value
!Projet = Me.Combo_Projet.Value
!AHNS = Me.Combo_Dessin.Value
.Update
.Close
End With
* You also asked how to execute an INSERT. Use the DAO.Database.Execute method which Zev recommended and include the dbFailOnError option. That will add clarity about certain insert failures. For example, a key violation error could otherwise make your INSERT fail silently. But including dbFailOnError ensures you get notified about the problem immediately. So always include that option ... except in cases where you actually want to allow an INSERT to fail silently. (For me, that's never.)

SQL query to replace all occurrences of space in a table with underscore

How can I write a SQL query to replace all occurrences of space in a table with underscore without writing individual statements for each column?
UPDATE [table_name] SET [field_name] = replace([field_name],' ','_'), [field_name2] = replace([field_name2],' ','_')
However, this way you still have to sum up every column, so above answer might fit more your need
Sometimes you don't need a hammer (code) even if the problem looks like a nail.
If this is a one-off task and the table isn't more than a few million rows you can just open the table and do a find and replace from the Edit menu (or ctrl-h) in Access.
This is one of those handy data manipulation capabilities of Access that make it so darn useful for ad-hoc database work.
Caveats:
(1) Performance won't be great on large tables, but works well for one-off data cleanup tasks in moderate sized tables (or when you are willing to wait a few minutes for it to finish on large tables.
(2) The locks this technique will create are a bit oppressive, so this isn't advised for a DB that is in active use by a large number of users.
You can use a mixture of VBA and SQL:
Dim rs As DAO.Recordset
Dim db As Database
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM TheTable")
For i = 0 To rs.Fields.Count - 1
''You may wish to check dbMemo as well as dbText
If rs.Fields(i).Type = dbText Then
''You have to watch out for single quotes as well as spaces
s = "UPDATE TheTable SET [" & rs.Fields(i).Name & "] = " _
& "Replace(Replace([" & rs.Fields(i).Name & "],""''"",""'""),"" "",""_"") " _
& "WHERE Instr([" & rs.Fields(i).Name & "],"" "")>0 " _
& "AND [" & rs.Fields(i).Name & "] Is Not Null"
db.Execute s, dbFailOnError
Debug.Print db.RecordsAffected
End If
Next