VBA grogramatically change query SQL based on user input - vba

I'm attempting to create a macro that based on a user input (on an excel sheet) will pull data from a query I made in Access. In order for it to pull only the applicable lines (rows) of data it needs to edit the WHERE statement accordingly. I have adapted the following code from a previous question but I am running into issues when I try to replace the SQL.
Private Sub CommandButton4_Click()
Const DbLoc As String = "MYfilepath"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim wb1 As Workbook, ws1 As Worksheet, ws2 As Worksheet, SQL As String, recCount As Long
Set wb1 = Workbooks("mytool.xlsm")
Set ws1 = wb1.Sheets("Inputs")
Set ws2 = wb1.Sheets("raw")
Set db = OpenDatabase(DbLoc)
Set userinput = ws1.Range("D6")
SQL = "SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID"
SQL = SQL & "FROM Dock_Rec_Problems;"
SQL = SQL & "WHERE [Dock_Rec_Problems_DGID] =" & userinput
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "Not found in database", vbInformation + vbOKOnly, "No Data"
GoTo SubExit
End If
ws2.Range("A1").CopyFromRecordset rs
SubExit:
On Error Resume Next
Application.Cursor = xlDefault
rs.Close
Set rs = Nothing
Exit Sub
End Sub
Let me know if there is anything I can clear up...thanks!
Original Query SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code,
Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP,
Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number,
Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description,
Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail,
Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems;
Single input SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000"));
Double input SQL
SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000")) OR (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323012"));

Because the size of your user input is open-ended, consider using a temp table saved in MS Access with exact structure as your query (can be built with: SELECT * INTO temp_table FROM myquery). Then, with each call of the Excel macro:
Clean the temp table out with DELETE.
Iterate through the user input Excel range of cells to append needed rows to table with INSERT INTO...SELECT.
Create recordset from temp table.
And once again, here is a prime use case for SQL parameterization especially since the query receives user input. A clever, malicious user can potentially clean out your database! But at the very least, code is arguably more maintainable. Because you are using DAO, consider QueryDefs to bind parameter value to a prepared, saved query and then bind into a recordset.
SQL (save as an MS Access stored action query)
PARAMETERS [userparam] TEXT(255);
INSERT INTO Excel_Table (Merch_Name, Vendor_Error_Code, DC, Vendor_ID_IP,
Vendor_Name, PO_Number, SKU_No, Item_Description,
Casepack, Retail, Num_Of_Cases, Dock_Rec_Problems_DGID)
SELECT d.Merch_Name, d.Vendor_Error_Code, d.DC, d.Vendor_ID_IP,
d.Vendor_Name, d.PO_Number, d.SKU_No, d.Item_Description,
d.Casepack, d.Retail, d.Num_Of_Cases, d.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems d
WHERE d.[Dock_Rec_Problems_DGID] = [userparam];
VBA
...
Dim qdef As DAO.QueryDef
Dim cel As Range
Set qdef = db.QueryDefs("mySavedQuery")
' CLEAN OUT TEMP EXCEL TABLE
db.Execute "DELETE FROM Excel_Table"
' ITERATIVELY APPEND TO EXCEL TABLES
For Each cel In userinput.Cells
qdef!userparam = cel.Value ' BIND PARAM
qdef.Execute dbFailOnError ' EXECUTE ACTION
Next cel
' OPEN RECORDSET TO TABLE
Set rs = db.OpenRecordset("Excel_Table", dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "Recieving problem not found in database", vbInformation+vbOKOnly, "No Data"
GoTo SubExit
End If
ws2.Range("A1").CopyFromRecordset rs
.......

There are a few problems with the code you've displayed. For instance, the strNewFields variable is attempted to be used, before you've set it to anything, here:
strNewSQL = strNewSQL & Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
At this point strNewFields is totally blank, but you're trying to do a replace.
I would suggest:
Change you WHERE_FIELDS Const from
Const WHERE_FIELDS As String = "WHERE " _
& "(((Dock_Rec_Problems.Dock_Rec_Problems_DGID) = <INSERT FIELDS>)); "
to
Const WHERE_FIELDS As String = "WHERE " _
& " [Dock_Rec_Problems].[Dock_Rec_Problems_DGID] IN (<INSERT FIELDS>); "
I find this easier to read then all the nested brackets, it removes the equals sign in preference of the IN() statement.
Now you want to populate the strNewFields variable with whatever inputs they gave you. Probably using a Do While Loop to iterate through the INPUTS. Each input is added to the strNewFields variable something like this.
Dim rs as Recordset
Set RS = currentdb.mydataset ' You need to modify this line
rs.Open
strNewFields = strNewFields & "'" & rs("InputFieldName") & "'"
rs.MoveNext
Do While rs.EOF = False
strNewFields = strNewFields & ",'" & rs("InputFieldName") & "'"
Loop
strNewFields = StrNewFields & ")"
Now that you have strNewFields populated you can simply run your replace()
Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
You need to look at the order in which you are setting variables though, as pointed out above, you've got some order of event issues.
Michael

Related

Showing a Query to Excel in VBA Access

I have this table:
And I did the next query that works for sure:
SELECT tbl_Type.Id_Type,
tbl_Type.Info,
tbl_Type.Id_Table_Three_Plus_Info,
tbl_Type.DateX
FROM tbl_Type
WHERE (((tbl_Type.DateX)=[Write Date (dd/dd/yyy)]));
As you see in the query in the WHERE part there's an input of the column DateX.
Now I want to use same procedure but using a form for the input, the code to do that is this:
Private Sub btn_Action_Click()
On Error Resume Next
'DoCmd.SetWarnings False
Dim Fecha As String
Fecha = _
"SELECT tbl_Type.Id_Type, tbl_Type.Info, tbl_Type.Id_Table_Three_Plus_Info, tbl_Type.DateX FROM tbl_Type WHERE tbl_Type.DateX = txt_Date.value;"
CurrentDb.CreateQueryDef ([Nom],Fecha) As QueryDef
DoCmd.RunSQL Fecha
'DoCmd.Save Fecha, "s"
txt_Date = Null
End Sub
First, I want to know if it is well performed the input in the content of the String Fecha. As you see I'm giving that action when the button btn_Action is clicked and capturing the input for DateX with a Text Field txt_Date I would say that the query is working but I don't know how to see that, in that order I proceed to pretend to save that query, which is something desired too. I've seen in another question that for do that is used CurrentDb.CreateQueryDef I tried DoCmd.Save but I think that isn't the case. With CurrentDb.CreateQueryDef I'm having a syntax error. Am I missing something?
Please, if more details are needed, still is a silly question or things like that let me now, to do the correct procedure!
Consider simply saving a parameterized query and then in VBA bind your form value to parameter using QueryDef object. MS Access SQL maintains the PARAMETERS clause to set named placeholders. Below outputs parameterized query results to Excel workbook.
SQL (save below as a query, Ribbon > Create > Query Design > SQL View)
PARAMETERS DateParam Datetime;
SELECT t.Id_Type,
t.Info,
t.Id_Table_Three_Plus_Info,
t.DateX
FROM tbl_Type t
WHERE (((t.DateX)=[DateParam]));
VBA (calls query, bind parameters, export to new Excel workbook)
Private Sub btn_Action_Click()
On Error Goto ErrHandle
Dim xl_app As Object, xl_wb As Objcect
Dim qdef As QueryDef, rst As Recordset
' REFERENCE SAVED QUERY
Set qdef = CurrentDb.QueryDef("mySavedQuery")
' BIND PARAMETER
qdef!DateParam = txt_Date
' SET qdef TO RECORDSET
Set rst = qdef.OpenRecordset()
' EXPORT TO EXCEL
Set xl_app = CreateObject("Excel.Application")
Set xl_wb = xl_app.Workbooks.Add()
With xl_wb.Sheets(1)
' COLUMNS
For i = 1 To rst.Fields.Count
.Cells(1, i) = rst.Fields(i - 1).Name
Next i
' DATA
.Range("A2").CopyFromRecordset rst
End With
xl_app.Visible = True
txt_Date = Null
ExitHandle:
rst.Close()
Set rst = Nothing: Set qdef = Nothing
Set xl_wb = Nothing: Set xl_app = Nothing
Exit Sub
ErrHandle:
Msgbox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Resume ExitHandle
End Sub
You have to concatenate the value of the input to your query string like so
Fecha = _
"SELECT tbl_Type.Id_Type, tbl_Type.Info, tbl_Type.Id_Table_Three_Plus_Info, tbl_Type.DateX FROM tbl_Type WHERE tbl_Type.DateX = " & txt_Date.value & ";"
To inspect the result, you should execute in debug mode (Press F8 instead of F5 in vba).

Microsoft Access - Crosstab of a filtered form

I'm trying to generate a report similar to a crosstab. The data are from a filtered form (Dates and WorkerID (String)).
form: frmReg
table with data: tReg
report: reportReg
On the following line:
Set qdf = dbsReport.QueryDefs(Me.RecordSource)
I'm getting the error:
Error 3265 Item not found in this collection
What am I doing wrong?
Private Sub Report_Open(Cancel As Integer)
' Create underlying recordset for report using criteria
Dim intX As Integer
Dim qdf As QueryDef
Dim frm As Form
' Don't open report if frmReg form isn't loaded.
If Not (IsLoaded("frmReg")) Then
Cancel = True
MsgBox "To preview or print this report, you must open " _
& "frmReg in Form view.", vbExclamation, _
"Must Open Dialog Box"
Exit Sub
End If
' Set database variable to current database.
Set dbsReport = CurrentDb
Set frm = Forms!frmReg
' Open QueryDef object.
' Set qdf = dbsReport.QueryDefs("ReportReg")
Me.RecordSource = "SELECT * FROM [tReg]"
Set qdf = dbsReport.QueryDefs(Me.RecordSource)
' Open Recordset object.
Set rstReport = qdf.OpenRecordset()
' Set a variable to hold number of columns in crosstab query.
intColumnCount = rstReport.Fields.Count
End Sub
It looks like the problem might be a relationship issue between the SQL and the commands and you probably do not have a query setup to take the information you are seeking.
Try this:
sSQL = "SELECT * FROM [tReg]"
Me.RecordSource = sSQL
Set qdf = dbsReport.CreateQueryDef("NewQuery", sSQL)
'This will purge the query after your inteactions are complete
dbsReport.QueryDefs.Delete "NewQuery"
Note: This will not include any interactions for the QueryDef.
The QueryDefs collection takes saved, named queries and not SQL statements. As #Jiggles32 demonstrates, you need to create a named query and then reference it with QueryDefs() call.
However, you can bypass the use of queries by simply directly opening recordsets with OpenRecordset() which is the end result of your needs:
strSQL = "SELECT * FROM [tReg]"
Me.RecordSource = strSQL
Set rstReport = dbsReport.OpenRecordset(strSQL)
' Set a variable to hold number of columns in crosstab query.
intColumnCount = rstReport.Fields.Count
In fact, you can directly extract a form's recordset using RecordsetClone property (preferred over Recordset if running various operations to not affect form's actual records):
strSQL = "SELECT * FROM [tReg]"
Me.RecordSource = strSQL
Set rstReport = Me.RecordsetClone
' Set a variable to hold number of columns in crosstab query.
intColumnCount = rstReport.Fields.Count

Filtered & ordered form datasheet to local table

I've been struggling all afternoon to write a function that will cache the displayed records in a form datasheet to a temporary table.
The use-case is that the user uses the datasheet auto-filters & sorting to get the records into their desired form. Then they're running a report function that outputs what they see as xml, runs it through an xslt transform to html. I can't get MSXML working direct from queries, hence the need for a local cached copy of what the user sees in the form datasheet.
What I have so far works, but seemingly ignores the filter & order by clauses in the sql string.
Private Sub CacheLocalTemp()
Dim strSql As String: strSql = "SELECT * INTO rpt_TEMP FROM tbl_Outputs"
If Len(Me.Filter) > 0 Then
strSql = strSql & " WHERE " & Me.Filter
End If
If Len(Me.OrderBy) > 0 Then
strSql = strSql & " ORDER BY " & Me.OrderBy
End If
DoCmd.SetWarnings False
DoCmd.RunSQL strSql
DoCmd.SetWarnings True
End Sub
I've seen methods using INSERT and SELECT INTO VALUES (x, y z), but didn't want to go down this route as it would mean I need to hard-code all field names, and there are a lot over about 10 different forms.
All the code I'm finding is long-winded / excessive, and I am astounded there isn't a more elegant / straight-forward way of just dumping a snapshot copy of what is displayed in the datasheet straight into its own table.
Any help would be much appreciated. Thanks.
You can solve this problem pretty easily by using a helper function that outputs a recordset to a table.
Helper function:
Public Sub RecordSetToTable(rs As DAO.Recordset, tableName As String)
Dim td As DAO.TableDef
Set td = CurrentDb.CreateTableDef(tableName)
Dim fld As DAO.Field
For Each fld In rs.Fields
td.Fields.Append td.CreateField(fld.Name, fld.Type, fld.Size)
Next
CurrentDb.TableDefs.Append td
Dim tableRS As DAO.Recordset
Set tableRS = CurrentDb.OpenRecordset(tableName)
rs.MoveFirst
Do While Not rs.EOF
tableRS.AddNew
For Each fld In rs.Fields
tableRS.Fields(fld.Name).Value = fld.Value
Next
tableRS.Update
rs.MoveNext
Loop
End Sub
On the form:
Private Sub CacheLocalTemp()
RecordSetToTable Me.Recordset, "rpt_TEMP"
End Sub
No messing around with constructing queries, ordering, etc. Just write the recordset straight to a new table.

Access VBA: Put values of a multi-select list box into a Table

I have a list box where I can select Monday- Friday. I can select as many days as I want in the list box, all of them if I wanted. I want to know how to insert the value of the listbox into my table.
Here's the code I've written so far:
Private Sub Command499_Click()
Set RstRecSet = Nothing
Set db = CurrentDb
Dim dateDay As String
Dim dateWeek As String
MsgBox (lstDateDay.Selected)
''dateWeek = lstDateWeek.Value
db.Execute " INSERT INTO tblContacts (DateDay, DateWeek)Values" & "('" & dateDay & "', '" & dateWeek & "');"
db.Close
End Sub
As you can see I've been trying a lot of different things. My problem is getting the value of the list box; it keeps showing as null even though it has data selected. The exact error I'm getting is:
"Invalid use of Null."
EDIT:
Set rs = db.OpenRecordset("tblContacts")
For Each itm In lstDateWeek.ItemsSelected
rs.AddNew
rs!dateWeek = lstDateWeek.ItemData(itm)
rs!dateDay = itm
rs.Update
Next
rs.Close
Set rs = Nothing
Set db = Nothing
dateDay and dateWeek are columns in tblContacts.
You need to use the ItemsSelected collection to get the index of the selected items in the Multi Select list box and then iterate through them and use the index to reference the rows stored in the ItemData collection. As part of this iteration simply create a record set and add the fields and update. There are different ways to handle this part but I like this one shown below.
To use my sample, simply create a table called tblTest and two columns Description (text) and Day as a number.
Create a form and add a multi-select list box named DaysOfWeek. fill it in with the days of the week as a ValueList and then add a button which I labeled Store.
Paste the following code into the buttons click event and try it
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblTest")
For Each itm In DaysOfWeek.ItemsSelected
rs.AddNew
rs!Description = DaysOfWeek.ItemData(itm)
rs!Day = itm
rs.Update
Next
rs.Close
Set rs = Nothing
Set db = Nothing
My event procedure looks like this:
Private Sub Command19_Click()
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblTest")
For Each itm In DaysOfWeek.ItemsSelected
rs.AddNew
rs!Description = DaysOfWeek.ItemData(itm)
rs!Day = itm
rs.Update
Next
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
This could be done with an ADO call by building a SELECT string for your INSERT statement as well but for me this is straightforward.. If you have any questions let me know. If I can figure out how to attach my sample database I will.

Access VBA: Query returns no rows

I've written some VBA:
For x = LBound(resProdID) To UBound(resProdID)
CurrentDb.QueryDefs("qry_findID_vba").SQL = "" & _
"SELECT tbl_products.ProdID " & _
"FROM tbl_products " & _
"WHERE (tbl_products.Size = " & resSize(x) & " " & _
"AND tbl_products.SupplID = '" & Forms.frm_suppliers.SupplID & "')"
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("qry_findID_vba")
MsgBox rst.RecordCount
If rst.RecordCount <> 0 Then
rst.MoveLast
rst.MoveFirst
newProdID(x) = rst.Fields(0).Value
MsgBox "This never fires"
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Next x
What happens when I run it, is that a box pops up saying 0. I click Ok, and it repeats one more time. This is because I have two items in my resProdID-array.
However, if I open the query "qry_findID_vba" normally, it shows one row, like I expected.
Why doesn't VBA return this row? Have I done anything wrong?
Does this code messagebox the correct count? Can you use it instead?
(Note, I haven't actually run it, so watch out for slight syntax errors.)
For x = LBound(resProdID) To UBound(resProdID)
Dim sql as String
Dim rst As DAO.Recordset
sql = "Select tbl_products.ProdID FROM tbl_products " & _
"WHERE (tbl_products.Size = " & resSize(x) & " " & _
"AND tbl_products.SupplID = '" & Forms.frm_suppliers.SupplID & "')"
Set rst = dbs.OpenRecordset(sql)
if not rst.eof then
MsgBox rst.fields("ProdID")
else
Msgbox "None found!"
end if
rst.Close
Set rst = Nothing
Next x
Also, try copying everything to a new form, and compacting and repairing the database ...
First off, you really should use QueryDef parameters. They provide a number of benefits:
A safety net against malformed input and SQL injection.
You don't need to redefine the query SQL text every time a parameter value changes.
They make your VBA independent of the query text. This is a simple query, but more complex ones benefit if you don't have to change your VBA code just to change the SQL.
They provide type safety - you can use typed variables in VBA and be sure that the query cannot fail with data type errors.
They can be re-used - parameterized queries can be bound to forms, or executed directly, for example.
Last but not least, it looks much nicer and clearer when used in VBA.
Your situation is exactly what parameterized QueryDefs are for.
Change the query text of qry_findID_vba in Access to:
PARAMETERS [ProductSize] Text (255), [SupplID] Number;
SELECT ProdID
FROM tbl_products
WHERE [tbl_products].[Size] = [ProductSize] AND [tbl_products].[SupplID] = [SupplID];
Replace the parameter data types according to your actual data types in the table.
Next, when you're in a loop, don't re-define fixed variables again and again. dbs and rst don't need to be defined inside the loop at all.
Last point, the RecordCount property does not work the way you think. Quote from the docs, emphasis mine:
Use the RecordCount property to find out how many records in a
Recordset or TableDef object have been accessed. 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.
[...]
To force the last record to be accessed, use the MoveLast method on the Recordset object.
Instead of calling MoveLast, you can also check the .EOF property. If it is false, at least one record is available.
For one-off query results like this one, I would recommend using the snapshot type Recordset. You can define which type you want to use when you call OpenRecordset on the QueryDef.
Now:
Dim qry_findID_vba As DAO.QueryDef
Set qry_findID_vba = CurrentDb().QueryDefs("qry_findID_vba")
qry_findID_vba.Parameters("SupplID") = Forms.frm_suppliers.SupplID
For x = LBound(resProdID) To UBound(resProdID)
qry_findID_vba.Parameters("ProductSize") = resSize(x)
With qry_findID_vba.OpenRecordset(dbOpenSnapshot)
If Not .EOF Then
newProdID(x) = .Fields("ProdID").Value
End If
End With
Next x
Note that I use With to save maintaining a helper rst variable.