For starters, I only started yesterday with the attempts of introducing SQL into my VBA code.
I'm trying to use VBA/SQL to Insert Data into a local table, made from a combination of a Database table and form input. I want to know how to trigger a "0 Lines retrieved".
I've already tried looking on several pages on how to handle "0 lines to Insert" when running a DoCmd.RunSQL("INSERT INTO ... SELECT ... FROM ... WHERE ...).
The code itself works when there is data present, so that's not the problem.
The problem itself is when I don't find data, I want to trigger a messagebox that gives instructions on how to handle the current situation.
Sadly, I have not found on how I can trigger this.
sqlTempInsert = "INSERT INTO tblScanInput (Support, EAN, Counted, Product, Description, Launched, Collected) " & _
"SELECT " & lblSupportData.Caption & ", " & txtEANInput.Value & ", "
If txtAmountInput.Visible = True Then
sqlTempInsert = sqlTempInsert & txtAmountInput.Value & ", "
ElseIf txtAmountInput.Visible = False Then
sqlTempInsert = sqlTempInsert & "1, "
End If
sqlTempInsert = sqlTempInsert & "GEPRO.CODPRO, GEPRO.DS1PRO, GESUPDC.UVCSRV, GESUPDC.UVCLIV " & _
"FROM [Database_Table] GESUPDC LEFT OUTER JOIN [Database_Table] GEPRO ON GESUPDC.CODPRO = GEPRO.CODPRO " & _
"WHERE GESUPDC.NUMSUP = " & lblSupportData.Caption & " AND GESUPDC.EDIPRO = '" & txtEANInput.Value & "';"
DoCmd.RunSQL(sqlTempInsert)
Use .Execute and .RecordsAffected.
Dim db As DAO.Database
Dim x As Long
Set db = CurrentDb
db.Execute sqlTempInsert, dbFailOnError
x = db.RecordsAffected
If x = 0 Then
' nothing was inserted
End If
Note: pay attention to Delete 5 Records but RecordsAffected Property is 0
Related
I am updating a small medical database. So far all new products have been added manually / directly to a Products- table. I am creating a form to do that.
Even it is in a way very simple to do, I am facing up a problem that data is inserted correctly only if all fields have something typed in form, if any of the input boxes are left empty no new records are made.
Additionally a simple check for minimum fields is not working. It will step thru all controls correctly but does not stop even a field is left empty and its Tag has *-sign in it.
Insert into includes all fields which a defined in that table there is not any extra field in table except first field is autonumbered ID field. No need to type something in every field each time.
Pr
Private Function CheckAllFields() As Boolean
Dim Ctrl As Control
CheckAllFields = False
'Go through the controls in Form
'If control has tag (*) and it null (no value) then show alert
For Each Ctrl In Me.Controls
MsgBox Ctrl.Name
If Ctrl.Tag = "*" And IsNull(Ctrl) Then
Dim FieldName As String
FieldName = Ctrl.Name
'Show notification if field was not filled and move focus to that field
MsgBox "A required Field has not been filled."
Ctrl.SetFocus
CheckAllFields = True
Exit For
End If
Next Ctrl
MsgBox "Check fileds done"
End Function
Private Sub AddProduct_Click()
Dim strSQL As String
'SQL to insert Product
strSQL = "INSERT INTO Products([Product name],[Product description],[Finnish name],[Finnish description],[Matrix2012], " & _
"[Additional Info], [Unit], [Licence],[Remarks],Narcotic,[Asset], " & _
"[ATC], [Cathegory], [EIC code], [EIC name])" & _
" VALUES ('" & Me.txtProductName & "','" & Me.txtProductDesc & "','" & Me.txtFinnishName & "','" & Me.txtFinnishDesc & "','" & Me.ComboMatrix & "'," & _
"'" & Me.txtAdditionalInfo & "','" & Me.ComboUnit & "','" & Me.CheckLicense & "'," & _
"'" & Me.txtRemarks & "','" & Me.CheckNarcotic & "','" & Me.CheckAsset & "'," & _
"'" & Me.txtATC & "','" & Me.txtCathegory & "','" & Me.txtEICcode & "','" & Me.txtEICName & "')"
'' MsgBox strSQL
'Check the all fields have valid format
If CheckAllFields = False Then
'Execute SQL in database - insert new batch
' MsgBox "Step into Check all fields"
CurrentDb.Execute strSQL
MsgBox "A new product inserted !"
End If
Here is a debug output of my insert into command:
Debug output
Here is another output debug, now the new product is inserted correctly.
Correctly working version
Problem solved. As Craig pointed this way of incuding parameters is prone to fail.
Here is good way to solve this. Did not believe it but after I tried it worked ultimate.
MS access running SQL doesn't insert data, no error
strSQL = "INSERT INTO Products([Product name],[Product description],[Finnish name],[Finnish description],[Matrix2012], " & _
"[Additional Info], [Unit], [Licence],[Remarks],Narcotic,[Asset], " & _
"[ATC], [Cathegory], [EIC code], [EIC name])" & _
" VALUES (ptxtProductName, ptxtProductDesc,ptxtFinnishName,ptxtFinnishDesc,pComboMatrix, ptxtAdditionalInfo,pComboUnit, pCheckLicense, ptxtRemarks, pCheckNarcotic, pCheckAsset, ptxtATC, ptxtCathegory, ptxtEICCode, ptxtEICName);"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL)
With qdf
.Parameters("ptxtProductName").Value = Me.txtProductName.Value
.Parameters("ptxtProductDesc").Value = Me.txtProductDesc.Value
.Parameters("ptxtFinnishName").Value = Me.txtFinnishName.Value
.Parameters("ptxtFinnishDesc").Value = Me.txtFinnishDesc.Value
.Parameters("pComboMatrix").Value = Me.ComboMatrix.Value
.Parameters("ptxtAdditionalInfo").Value = Me.txtAdditionalInfo.Value
.Parameters("pComboUnit").Value = Me.ComboUnit.Value
.Parameters("pCheckLicense").Value = Me.CheckLicense.Value
.Parameters("ptxtRemarks").Value = Me.txtRemarks.Value
.Parameters("pCheckNarcotic").Value = Me.CheckNarcotic.Value
.Parameters("pCheckAsset").Value = Me.CheckAsset.Value
.Parameters("ptxtATC").Value = Me.txtATC.Value
.Parameters("ptxtCathegory").Value = Me.txtCathegory.Value
.Parameters("ptxtEICCode").Value = Me.txtEICcode.Value
.Parameters("ptxtEICName").Value = Me.txtEICName.Value
.Execute dbFailOnError
End With
Debug.Print db.RecordsAffected
That check for empty fields is mystery, it works in another form so it has to be some sort of reference problem. Anyway to keep things simple this works perfectly:
If txtProductName.Value = "" Or ComboMatrix.Value = "" Or ComboUnit.Value = "" Then
'Show notification if field was not filled and move focus to that field
MsgBox "A required Field has not been filled."
Original code link: MS Access - Convert rows values into columns values
I have a follow up to a question where the answer didn't completely resolve, but got super close. It was asked at the original code link above. It's the single page on the net that actually addresses the issue of transposing multiple values in a one-to-many relationship set of columns to a single row for each related value in a dynamic manner specifically using VBA. Variations of this question have been asked about a dozen times on this site and literally none of the answers goes as far as Vlado did (the user that answered), which is what's necessary to resolve this problem.
I took what Vlado posted in that link, adjusted it for my needs, did some basic cleanup, worked through all the trouble-shooting and syntax problems (even removed a variable declared that wasn't used: f As Variant), and found that it works almost all the way. It generates the table with values for the first two columns correctly, iterates the correct number of variable count columns with headers correctly, but fails to populate the values within the cells for each of the related "many-values". So close!
In order to get it to that point, I have to comment-out db.Execute updateSql portion of the Transpose Function; 3rd to last row from the end. If I don't comment that out, it still generates the table, but it throws a Run-Time Error 3144 (Syntax error in UPDATE statement) and only creates the first row and all the correct columns with correct headers (but still no valid values inside the cells). Below is Vlado's code from the link above, but adjusted for my field name needs, and to set variables at the beginning of each of the two Functions defined. The second Function definitely works correctly.
Public Function Transpose()
Dim DestinationCount As Integer, i As Integer
Dim sql As String, insSql As String, fieldsSql As String, updateSql As String, updateSql2 As String
Dim db As DAO.Database, rs As DAO.Recordset, grp As DAO.Recordset
Dim tempTable As String, myTable As String
Dim Var1 As String, Var2 As String, Var3 As String, Var4 As String
tempTable = "Transposed" 'Value for Table to be created with results
myTable = "ConvergeCombined" 'Value for Table or Query Source with Rows and Columns to Transpose
Var1 = "Source" 'Value for Main Rows
Var2 = "Thru" 'Value for Additional Rows
Var3 = "Destination" 'Value for Columns (Convert from Rows to Columns)
Var4 = "Dest" 'Value for Column Name Prefixes
DestinationCount = GetMaxDestination
Set db = CurrentDb()
If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tempTable & "'")) Then
DoCmd.DeleteObject acTable, tempTable
End If
fieldsSql = ""
sql = "CREATE TABLE " & tempTable & " (" & Var1 & " CHAR," & Var2 & " CHAR "
For i = 1 To DestinationCount
fieldsSql = fieldsSql & ", " & Var4 & "" & i & " INTEGER"
Next i
sql = sql & fieldsSql & ")"
db.Execute (sql)
insSql = "INSERT INTO " & tempTable & " (" & Var1 & ", " & Var2 & ") VALUES ("
Set grp = db.OpenRecordset("SELECT DISTINCT " & Var1 & ", " & Var2 & " FROM " & myTable & " GROUP BY " & Var1 & ", " & Var2 & "")
grp.MoveFirst
Do While Not grp.EOF
sql = "'" & grp(0) & "','" & grp(1) & "')"
db.Execute insSql & sql
Set rs = db.OpenRecordset("SELECT * FROM " & myTable & " WHERE " & Var1 & " = '" & grp(0) & "' AND " & Var2 & " = '" & grp(1) & "'")
updateSql = "UPDATE " & tempTable & " SET "
updateSql2 = ""
i = 0
rs.MoveFirst
Do While Not rs.EOF
i = i + 1
updateSql2 = updateSql2 & "" & Var3 & "" & i & " = " & rs(2) & ", " ' <------- MADE CHANGE FROM (3) to (2)
rs.MoveNext
Loop
updateSql = updateSql & Left(updateSql2, Len(updateSql2) - 1) & " WHERE " & Var1 & " = '" & grp(0) & "' AND " & Var2 & " = '" & grp(1) & "'"
db.Execute updateSql ' <-- This is the point of failure
grp.MoveNext
Loop
End Function
Public Function GetMaxDestination()
Dim rst As DAO.Recordset, strSQL As String
myTable = "ConvergeCombined" 'Value for Table or Query Source with Rows and Columns to Transpose
Var1 = "Source" 'Value for Main Rows
Var2 = "Thru" 'Value for Additional Rows
Var3 = "Destination" 'Value for Columns (Convert from Rows to Columns)
strSQL = "SELECT MAX(CountOfDestination) FROM (SELECT Count(" & Var3 & ") AS CountOfDestination FROM " & myTable & " GROUP BY " & Var1 & ", " & Var2 & ")"
Set rst = CurrentDb.OpenRecordset(strSQL)
GetMaxDestination = rst(0)
rst.Close
Set rst = Nothing
End Function
Sample Table:
Sample Data:
Add a Debug.Print updateSql before that Execute line and will see improper syntax in SQL statement. Need to trim trailing comma from updateSql2 string. Code is appending a comma and space but only trims 1 character. Either eliminate space from the concatenation or trim 2 characters.
Left(updateSql2, Len(updateSql2) - 2)
Concatenation for updateSql2 is using Var3 instead of Var4.
Source field is a number type in ConvergeCombined and this triggers a 'type mismatch' error in SELECT statement to open recordset because of apostrophe delimiters Var1 & " = '" & grp(0) & "' - remove them from two SQL statements.
Also, Source value is saved to a text field in Transposed, make it INTEGER instead of CHAR in the CREATE TABLE action.
So with the help of a friend I figured it out. It turns out I needed two Functions because the one-to-many relationships go both directions in my case. I explain below what needs to happen in comments for this to work. Essentially I went with the second comment under the question I posed (pre-defining field names in static tables because there is a limited number of fields that any person will need - it can't exceed 256 fields anyway, but it isn't always practical to use more than a dozen or so fields - this way allows for both and at the same time to simplify the code significantly).
This solution actually works - but it's dependent on having tables (or queries in my situation) labeled ConvergeSend and ConvergeReceive. Also, it's important to note that the instances where the Destination is single and the Source is plural, the table or query (ConvergeSend/ConvergeReceive) must have the Destination value as a column TO THE LEFT of the iterated Source columns. This is also true (but reverse naming convention) for the other table/query (the Source column must be TO THE LEFT of the iterated Destination columns).
' For this code to work, create a table named "TransposedSend" with 8 columns: Source, Destination1, Destination2,...Destination7; OR however many you need
' Save the table, Edit it, change all field values to Number and remove the 0 as Default Value at the bottom
' Not changing the field values to Number causes the Insert Into function to append trailing spaces for no apparent reason
Public Function TransposeSend()
Dim i As Integer
Dim rs As DAO.Recordset, grp As DAO.Recordset
CurrentDb.Execute "DELETE * FROM TransposedSend", dbFailOnError
CurrentDb.Execute "INSERT INTO TransposedSend (Source) SELECT DISTINCT Source FROM ConvergeSend GROUP BY Source", dbFailOnError
Set grp = CurrentDb.OpenRecordset("SELECT DISTINCT Source FROM ConvergeSend GROUP BY Source")
grp.MoveFirst
Do While Not grp.EOF
Set rs = CurrentDb.OpenRecordset("SELECT Source, Destination, [Destination App Name] FROM ConvergeSend WHERE Source = " & grp(0))
i = 0
rs.MoveFirst
Do While Not rs.EOF
i = i + 1
CurrentDb.Execute "UPDATE TransposedSend SET Destination" & i & " = '" & rs(1) & "', [Destination" & i & " App Name] = '" & rs(2) & "'" & " WHERE Source = " & grp(0)
rs.MoveNext
Loop
grp.MoveNext
Loop
End Function
' For this code to work, create a table named "TransposedReceive" with 8 columns: Destination, Source1, Source2,...Source7; OR however many you need
' Save the table, Edit it, change all field values to Number and remove the 0 as Default Value at the bottom
' Not changing the field values to Number causes the Insert Into function to append trailing spaces for no apparent reason
Public Function TransposeReceive()
Dim i As Integer
Dim rs As DAO.Recordset, grp As DAO.Recordset
CurrentDb.Execute "DELETE * FROM TransposedReceive", dbFailOnError
CurrentDb.Execute "INSERT INTO TransposedReceive (Destination) SELECT DISTINCT Destination FROM ConvergeReceive GROUP BY Destination", dbFailOnError
Set grp = CurrentDb.OpenRecordset("SELECT DISTINCT Destination FROM ConvergeReceive GROUP BY Destination")
grp.MoveFirst
Do While Not grp.EOF
Set rs = CurrentDb.OpenRecordset("SELECT Destination, Source, [Source App Name] FROM ConvergeReceive WHERE Destination = " & grp(0))
i = 0
rs.MoveFirst
Do While Not rs.EOF
i = i + 1
CurrentDb.Execute "UPDATE TransposedReceive SET Source" & i & " = '" & rs(1) & "', [Source" & i & " App Name] = '" & rs(2) & "'" & " WHERE Destination = " & grp(0)
rs.MoveNext
Loop
grp.MoveNext
Loop
End Function
The following was written to inform a user if they are entering duplicate information.
It never detects the duplicate, but all else around it works.
The values from debug (for formats etc.) are
me.lisAppID = 1
me.dtReviewDate = 10/09/2015
me.txtReviewerName = colin
This is the query
Dim tmpRS As DAO.Recordset
Set tmpRS = CurrentDb.OpenRecordset("SELECT TblReview.ReviewID FROM TblReview Where (TblReview.AppID = " & Me.lisAppID & ") And (TblReview.RevDateTime)= #" & Me.dtReviewDate _
& "# And (TblReview.RevUserID)= '" & Me.txtReviewerName & "'")
If tmpRS.RecordCount > 0 Then
MsgBox "Record is a duplicate, it will not be saved", vbOKOnly
Cancel = 1
Exit Sub
End If
Set tmpRS = Nothing
Here are some things to try.
Explicitly format your date variable when building the sql string:
Set tmpRS = CurrentDb.OpenRecordset("SELECT TblReview.ReviewID FROM TblReview Where (TblReview.AppID = " & Me.lisAppID _
& ") And (TblReview.RevDateTime)= #" & Format(Me.dtReviewDate,"mm/dd/yyyy") _
& "# And (TblReview.RevUserID)= '" & Me.txtReviewerName & "'")
Consider using the optional parameters in the OpenRecordset method. Some types of connection do not actually return a value for the Recordset.RecordCount property. From MSDN:
The RecordCount property doesn't indicate how many records are contained in a dynaset–, snapshot–, or forward–only–type Recordset object until all records have been accessed.
In the following code, I would like to join ADODB record set 'rs3' to table 'tblValueChain10' and update 3 different columns based on the values extracted in the ADODB record set 'rs3'. Currently, the update query is not returning anything.
Dim st_Sql3 As String
Dim rs3 As ADODB.Recordset
Set rs3 = New ADODB.Recordset
Dim Max3 As Integer
rs3.Open "SELECT tblRisk05Holding.IDMacroProcesso01, tblRisk05Holding.Level01Risk, Max(tblRisk05Holding.ManualityStatus) AS MaxDiManualityStatus, Max(tblRisk05Holding.RiskProbabilityStatus) AS MaxDiRiskProbabilityStatus, Max(tblRisk05Holding.RiskExposureStatus) AS MaxDiRiskExposureStatus FROM tblRisk05Holding GROUP BY tblRisk05Holding.IDMacroProcesso01, tblRisk05Holding.Level01Risk", CurrentProject.Connection
st_Sql3 = "UPDATE tblValueChain10 INNER JOIN rs3 ON (tblValueChain10.IDMacroProcesso01 = tblRisk05Holding.IDMacroProcesso01) SET L1RiskManuality = " & rs3.Fields(2) & ", L1RiskProbability = " & rs3.Fields(3) & ", L1RiskGravity = " & rs3.Fields(4) & ""
Application.DoCmd.RunSQL (st_Sql2)
rs3.Close
Set rs3 = Nothing
Access never allows you to use a recordset object as a data source in another query. It doesn't matter whether you have an ADO or DAO recordset; you can't do it. And the query type (SELECT, UPDATE, INSERT, etc.) also doesn't matter; you can't use a recordset object as a data source in any query type.
You might get a workable UPDATE by first saving your SELECT statement as a named query, qryRS3. Then revise the UPDATE to INNER JOIN tblValueChain10 to qryRS3. But I'm uncertain whether Access would consider that query to be updatable; the GROUP BY might cause Access to treat it as not updatable. You'll have to test to see.
Although the goal you try to achieve using ADO Recordset in the way presented can't be done (as user #HansUp wrote), you could try the approach with updating your table tblValueChain10 using subquery taken from the rs3 recordset open call.
I hope that the following query :
UPDATE
tblValueChain10
INNER JOIN
(
SELECT
tblRisk05Holding.IDMacroProcesso01,
tblRisk05Holding.Level01Risk,
Max(tblRisk05Holding.ManualityStatus) AS MaxDiManualityStatus,
Max(tblRisk05Holding.RiskProbabilityStatus) AS MaxDiRiskProbabilityStatus,
Max(tblRisk05Holding.RiskExposureStatus) AS MaxDiRiskExposureStatus
FROM
tblRisk05Holding
GROUP BY
tblRisk05Holding.IDMacroProcesso01,
tblRisk05Holding.Level01Risk
) AS qry_Risk05Holding
ON (tblValueChain10.IDMacroProcesso01 = qry_Risk05Holding.IDMacroProcesso01)
SET
tblValueChain10.L1RiskManuality = qry_Risk05Holding.MaxDiManualityStatus,
tblValueChain10.L1RiskProbability = qry_Risk05Holding.MaxDiRiskProbabilityStatus,
tblValueChain10.L1RiskGravity = qry_Risk05Holding.MaxDiRiskExposureStatus
could help you solve your problem.
You should be able to run the above SQL with the following code:
Dim st_Sql3 As String
st_Sql3 = " UPDATE tblValueChain10 INNER JOIN ( "
st_Sql3 = st_Sql3 & " SELECT " _
& " tblRisk05Holding.IDMacroProcesso01, " _
& " tblRisk05Holding.Level01Risk, " _
& " Max(tblRisk05Holding.ManualityStatus) AS MaxDiManualityStatus, " _
& " Max(tblRisk05Holding.RiskProbabilityStatus) AS MaxDiRiskProbabilityStatus, " _
& " Max(tblRisk05Holding.RiskExposureStatus) AS MaxDiRiskExposureStatus "
st_Sql3 = st_Sql3 & " FROM " _
& " tblRisk05Holding " _
& " GROUP BY " _
& " tblRisk05Holding.IDMacroProcesso01, " _
& " tblRisk05Holding.Level01Risk "
st_Sql3 = st_Sql3 & " ) AS qry_Risk05Holding " _
& " ON (tblValueChain10.IDMacroProcesso01 = qry_Risk05Holding.IDMacroProcesso01) " _
& " SET " _
& " tblValueChain10.L1RiskManuality = qry_Risk05Holding.MaxDiManualityStatus, " _
& " tblValueChain10.L1RiskProbability = qry_Risk05Holding.MaxDiRiskProbabilityStatus, " _
& " tblValueChain10.L1RiskGravity = qry_Risk05Holding.MaxDiRiskExposureStatus "
Application.DoCmd.RunSQL (st_Sql3)
The query is being built-up in four stages because as far as I remember there is a restriction in VBA that there can't be too many line breaks _.
Please notice also that the JOIN used in the update query assumes that connecting two tables by IDMacroProcesso01 would ensure that the records are updated in the right way.
I can't check the solution in Acces right now but maybe it could somehow help you, at least a concept. If there were any errors, please write.
You need to loop through the recordset to iteratively update by each record:
Do While NOT rs3.EOF
st_Sql3 = "UPDATE tblValueChain10"_
& " INNER JOIN rs3 ON (tblValueChain10.IDMacroProcesso01 = tblRisk05Holding.IDMacroProcesso01)" _
& " SET L1RiskManuality = " & rs3.Fields(2) & ", L1RiskProbability = " & rs3.Fields(3) & "," _
& " L1RiskGravity = " & rs3.Fields(4) & ""
DoCmd.RunSQL (st_Sql3)
rs3.MoveNext
Loop
Also please note, your RunSQL () command is calling the incorrect SQL string.
If no err appears, then try to place this code:
Set rs3 = New ADODB.Recordset
in form_load, as in,
private sub Form_load()
Set rs3 = New ADODB.Recordset
End Sub
note: this sample is in vb6.0. that's what I can do. Besides, check the version in references
I have an array which can have a different amount of values, depending on the situation. I want to put these values as a parameter in a query in ms access.
The problem is, if I use the following code to generate a parameter, it sends the whole string as one value to the query, which obviously does not return any rows.
Do Until i = size + 1
If Not IsEmpty(gvaruocat(i)) Then
If Not IsEmpty(DLookup("uo_cat_id", "tbl_uo_cat", "[uo_cat_id] = " & CInt(gvaruocat(i)))) Then
If IsEmpty(get_uocat_param) Then
get_uocat_param = CInt(gvaruocat(i))
Else
get_uocat_param = get_uocat_param & " OR tbl_uo_step.uo_step_cat = " & CInt(gvaruocat(i))
End If
End If
End If
i = i + 1
Loop
At the moment I have 'Fixed' it by generating an SQL string and leaving the query out all together.
get_uocat = "SELECT tbl_product.prod_descr, tbl_uo_cat.uo_cat_descr, tbl_uo_step.uo_step_descr" & vbCrLf _
& "FROM (tbl_product INNER JOIN tbl_uo_cat ON tbl_product.prod_id = tbl_uo_cat.uo_cat_prod) INNER JOIN tbl_uo_step ON tbl_uo_cat.uo_cat_id = tbl_uo_step.uo_step_cat" & vbCrLf _
& "WHERE (((tbl_uo_step.uo_step_cat) = " & get_uocat_param & ")) " & vbCrLf _
& "ORDER BY tbl_product.prod_descr, tbl_uo_cat.uo_cat_descr, tbl_uo_step.uo_step_descr;"
This is however not very friendly to many changes. So my question is, how do I get the array to send each value as a separate parameter to the query?
Note: IsEmpty() is a custom function which checks for empty variables in case you were wondering.
You can still use a parameterized query in this case, despite your comment to the question. You just need to build the SQL string to include as many parameters as required, something like this:
Dim cdb As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
Dim sql As String, i As Long
' test data
Dim idArray(1) As Long
idArray(0) = 1
idArray(1) = 3
Set cdb = CurrentDb
sql = "SELECT [LastName] FROM [People] WHERE [ID] IN ("
' add parameters to IN clause
For i = 0 To UBound(idArray)
sql = sql & "[param" & i & "],"
Next
sql = Left(sql, Len(sql) - 1) ' trim trailing comma
sql = sql & ")"
Debug.Print sql ' verify SQL statement
Set qdf = cdb.CreateQueryDef("", sql)
For i = 0 To UBound(idArray)
qdf.Parameters("param" & i).Value = idArray(i)
Next
Set rst = qdf.OpenRecordset(dbOpenSnapshot)
' check results
Do Until rst.EOF
Debug.Print rst!LastName
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
Set qdf = Nothing
Set cdb = Nothing
When I run this on my test database I get
SELECT [LastName] FROM [People] WHERE [ID] IN ([param0],[param1])
Thompson
Simpson
you could make use of the IN Clause, instead. Which would work out better.
Do Until i = size + 1
If Not IsEmpty(gvaruocat(i)) Then
If Not IsEmpty(DLookup("uo_cat_id", "tbl_uo_cat", "[uo_cat_id] = " & CInt(gvaruocat(i)))) Then
If IsEmpty(get_uocat_param) Then
get_uocat_param = CInt(gvaruocat(i))
Else
get_uocat_param = get_uocat_param & ", " & CInt(gvaruocat(i))
End If
End If
End If
i = i + 1
Loop
Then your Query build could use,
get_uocat = "SELECT tbl_product.prod_descr, tbl_uo_cat.uo_cat_descr, tbl_uo_step.uo_step_descr" & vbCrLf _
& "FROM (tbl_product INNER JOIN tbl_uo_cat ON tbl_product.prod_id = tbl_uo_cat.uo_cat_prod) INNER JOIN tbl_uo_step ON tbl_uo_cat.uo_cat_id = tbl_uo_step.uo_step_cat" & vbCrLf _
& "WHERE ((tbl_uo_step.uo_step_cat IN (" & get_uocat_param & "))) " & vbCrLf _
& "ORDER BY tbl_product.prod_descr, tbl_uo_cat.uo_cat_descr, tbl_uo_step.uo_step_descr;"